{ Unit Principal of Main Screen

  Copyright (C) 2007 Liyuan Garcia Caballero liyuangarcia@gmail.com

  This source is free software; you can redistribute it and/or modify it under
  the terms of the GNU General Public License as published by the Free
  Software Foundation; either version 3 of the License, or (at your option)
  any later version.

  This code is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  details.

  A copy of the GNU General Public License is available on the World Wide Web
  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  MA 02111-1307, USA.
}


unit uprinc;

{$mode objfpc}{$H+}


interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
  ExtCtrls, Buttons, StdCtrls, mimemess, smtpsend, synaip, blcksock,
  mimepart, sdfdata, DBCtrls, Menus, synachar, translations, XMLCfg, ActnList, uabout, uprefer, Spin, dnssend, synamisc, synautil,
  Grids, Dbf, DCPsha512, DCPrc4, LCLType, uinclude, db,actionseditor,
  uupdates, EditBtn, pingsend, tlntsend, RegExpr, strutils, process,udetails,
  urecip, IniPropStorage, DBGrids, md5;



{ Torelay }

type

{ Thorelay }

Thorelay = class(TThread)
  private
    Fhost: String;
    Fport: String;
    FSystemN, Fdomain_ext: String;
    Ftimeout, Fmess, Fwait, hole, secur: Integer;
    smtp: TSMTPSend;
    Fip : String;
    Fimage : Byte;
    Fuserext, Fuserloc: String;
    Fresult, Fdescrip : String;
    mens_header, filedetails, buildxgraph : TstringList;
    header : TMessHeader;
    table : TSdfDataSet;
    Fvalpb,Fpb_max, Fctest : integer;
    procedure putresult_or;
    procedure putgraph;
    procedure putincpb_or;
    procedure pb_maxpos;
    procedure genwarning;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended : Boolean; Ahost,Aport,AsystemN,Adomain_ext,Aip,Auserext,Auserloc : String; Atimeout,messa,wait,Actest: integer);
  end;


{ Tvirus }

type

Tvirus = class(TThread)
  private
    Fhost : String;
    Fport : String;
    FSystemN, Fdomain_ext: String;
    Ftimeout : Integer;
    smtp: TSMTPSend;
    Fip : String;
    Fuserfrom, Fuserto: String;
    Fresult : String;
    mens_text : TstringList;
    mime : TMimePart;
    mbody : TMimeMess;
    table : Tdbf;
    Cipher : TDCP_rc4;
    Fvapb : integer;
    Fwait, Fmess : integer;
    procedure putresult_vt;
    procedure putincpb_vt;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended: Boolean; Ahost,Aport,AsystemN,Adomain_ext,Aip,Auserfrom,Auserto : String; Atimeout,Await,Amess : integer );
  end;


{ Tspam }

type

Tspam = class(TThread)
  private
    Fhost : String;
    Fport : String;
    FSystemN, Fdomain_ext: String;
    Ftimeout, Fcateg : Integer;
    smtp: TSMTPSend;
    Fip : String;
    Fuserfrom, Fuserto: String;
    Fresult : String;
    mes_text : TstringList;
    mime : TMimePart;
    mbody : TMimeMess;
    procedure putresult_st;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended : Boolean; Ahost,Aport,AsystemN,Aip,Auserfrom,Auserto, Adomain_ext : String; Atimeout, Acateg : integer );
  end;


 { Tperformance }

 Tperformance = class(TThread)
  private
    Fhost : String;
    Fport : String;
    FSystemN, Fdomain_ext: String;
    Ftimeout, Fcount : Integer;
    smtp: TSMTPSend;
    Fip : String;
    Fuserfrom, Fuserto: String;
    Fsize, Fresult : String;
    mens_text : TstringList;
    mime : TMimePart;
    mbody : TMimeMess;
    table : Tdbf;
    Fvalpb : integer;
    procedure putresult_p;
    procedure putincpb_p;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended : Boolean; Ahost,Aport,AsystemN,Adomain_ext,Aip,Auserfrom,Auserto,Asize : String; Atimeout, Acount : integer );
  end;



{ Tinfo }

Tinfo = class(TThread)
  private
    Fhost: String;
    Fport: String;
    FSystemN, Fdomain_ext: String;
    Ftimeout: Integer;
    smtp: TSMTPSend;
    telnt : TTelnetSend;
    Fip,filelogo, logourl,product_info, product_ver : String;
    product_os, product_host, product_size : String;
    Fresult : String;
    Fcb_etrn, Fcb_vrfy, Fcb_help, Fcb_expn, Fcb_size : Boolean;
    Fcb_auth, Fcb_tls,Fcb_swver : Boolean;
    Fed_etrn, Fed_vrfy, Fed_help, Fed_expn : String;
    table : TSdfDataSet;
    filedetails : TStringList;
    procedure putresult_info;
    procedure valid_resp (value : TStringList);
    procedure showlogo;
  protected
   procedure Execute; override;
    function getvaluestr (cad,sep : String) : String;
    function Parseversion (const AInputString, ATemplate, exp : string) : string;
  public
   constructor Create(CreateSuspended, Acb_etrn, Acb_vrfy, Acb_help, Acb_expn,
   Acb_size, Acb_auth, Acb_tls, Acb_sver : Boolean; Ahost,Aport,AsystemN,Adomain_ext,Aip,
   Aed_etrn, Aed_vrfy, Aed_help, Aed_expn : String; Atimeout: integer );
  end;


{ Tresolvemx }

Tresolvemx = class(TThread)
  private
    Sock : TBlockSocket;
    List : TStringList;
    Fresult1,Fresult2 : String;
    DomainN : String;
    procedure putresult_mx;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended : Boolean; Adomain:String);
  end;

{ Tresolvip }

Tresolvip = class(TThread)
  private
    Sock : TBlockSocket;
    List : TStringList;
    HostN : String;
    procedure putresult_ip;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended : Boolean; Ahost : String);
  end;


{ Tdnsbl }

type

Tdnsbl = class(TThread)
  private
    Ftimeout: Integer;
    dnsclient: TDNSSend;
    Fip, Fdnserver : String;
    Fresult : String;
    Fsetdns : Boolean;
    table : Tdbf;
    Fvalpb_dnsbl : integer;
    procedure putresult_dnsbl;
    procedure putincpb_dnsbl;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended, Asetdns : Boolean; Aip, Adnserver: String; Atimeout: integer);
  end;

{ Tspf }

type

Tspf = class(TThread)
  private
    Ftimeout: Integer;
    dnsclient: TDNSSend;
    Fresult, Fdomain  : String;
    FArec, FMXrec, FPTRrec, Fall : Boolean;
    FMA, FMMX, FMIPV4, Fedinclude: String;
    procedure putresult_spf;
  protected
   procedure Execute; override;
   procedure Not_found;
  public
   constructor Create(CreateSuspended, AArec, AMXrec,APTRrec, Aallrec  : Boolean;
   ADomain, Ama, Ammx, Amipv4, Aedinclude: String; Atimeout: integer);
  end;

{ TPingClient }

type

TPingClient = class(TThread)
  private
    ping_client: TPINGSend;
    Fip : String;
    Fresult : String;
    Fvalpb_ping : integer;
    Fcount, Fbytes : integer;
    procedure putresult_ping;
    procedure putincpb_ping;
  protected
   procedure Execute; override;
  public
   constructor Create(CreateSuspended: Boolean; Aip: String; Acount, Abytes: integer);
  end;


type

  { Tfprincipal }

  Tfprincipal = class(TForm)
    acopenrelay: TAction;
    acspamtest: TAction;
    acetrn: TAction;
    achelp: TAction;
    acsave: TAction;
    acexit: TAction;
    acpreferences: TAction;
    acabout: TAction;
    acopenrelay_stop: TAction;
    acspamtest_stop: TAction;
    acperform: TAction;
    acperform_stop: TAction;
    acinfo: TAction;
    acinfo_stop: TAction;
    acdnsbl: TAction;
    acdnsbl_stop: TAction;
    acspf_start: TAction;
    acping_start: TAction;
    acping_stop: TAction;
    ac_orelay_details: TAction;
    ac_recip: TAction;
    ac_resolvemx: TAction;
    acupdates: TAction;
    acvirustest_stop: TAction;
    achelp_app: TAction;
    acverify: TAction;
    acvirustest: TAction;
    ActionList1: TActionList;
    ApplicationProperties1: TApplicationProperties;
    Button1: TButton;
    cbsize: TComboBox;
    cb_info_swver: TCheckBox;
    cb_spf_a: TCheckBox;
    cb_info_etrn: TCheckBox;
    cb_spf_mx: TCheckBox;
    cb_spf_ptr: TCheckBox;
    cb_spf_all: TCheckBox;
    cb_info_vrfy: TCheckBox;
    cb_info_help: TCheckBox;
    cb_info_expn: TCheckBox;
    cb_info_size: TCheckBox;
    cb_info_auth: TCheckBox;
    cb_info_tls: TCheckBox;
    dbg_orinclude: TDBGrid;
    ds_torelay: TDatasource;
    gbping1: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox5: TGroupBox;
    im_info_product: TImage;
    iniconfig: TIniPropStorage;
    lhost: TLabel;
    lb_info_os: TLabel;
    lb_info_size: TLabel;
    lb_info_product: TLabel;
    lb_info_host: TLabel;
    ltimeout_concurrency: TLabel;
    lthreads_concurrency: TLabel;
    MenuItem14: TMenuItem;
    m_spf_ipv4: TEdit;
    m_spf_mx: TEdit;
    m_spf_a: TEdit;
    ed_info_etrn: TEdit;
    ed_info_vrfy: TEdit;
    ed_info_help: TEdit;
    ed_info_expn: TEdit;
    edip: TComboBox;
    ededomain: TEdit;
    ed_pf_dnsbl: TEdit;
    ed_spf_include: TEdit;
    gbantivirus: TGroupBox;
    gbping: TGroupBox;
    gbperformance: TGroupBox;
    GroupBox1: TGroupBox;
    gbinfo: TGroupBox;
    gborelay: TGroupBox;
    gb_spf: TGroupBox;
    lmessage_or: TLabel;
    lcount_ping: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    lwait_or: TLabel;
    lwait_av: TLabel;
    lsize_ping: TLabel;
    Label9: TLabel;
    lbarrob: TLabel;
    Label3: TLabel;
    lmessage_av: TLabel;
    Label7: TLabel;
    lmessage: TLabel;
    lsize: TLabel;
    MenuItem1: TMenuItem;
    MenuItem11: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem9: TMenuItem;
    menu_performance: TMenuItem;
    MenuItem10: TMenuItem;
    MenuItem12: TMenuItem;
    menu_updates: TMenuItem;
    menutest: TMenuItem;
    MenuItem20: TMenuItem;
    MenuItem21: TMenuItem;
    menu_open_relay: TMenuItem;
    menu_start: TMenuItem;
    menu_stop: TMenuItem;
    menu_virus: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    menu_spam: TMenuItem;
    pn_btn_orelay: TPanel;
    pbinfo: TProgressBar;
    pbping: TProgressBar;
    pbvirus: TProgressBar;
    pcontrol_result: TPageControl;
    pborelay: TProgressBar;
    pbperf: TProgressBar;
    pbdnsbl: TProgressBar;
    prochttp: TProcess;
    pb_orelay_status: TProgressBar;
    rbdns1: TRadioButton;
    rbdns2: TRadioButton;
    rg1: TRadioGroup;
    sb_orelay_details: TSpeedButton;
    sb_info_url: TSpeedButton;
    sdfcomun: TSdfDataSet;
    senmessages: TSpinEdit;
    se_concurrency_timeout: TSpinEdit;
    se_concurrency_threads: TSpinEdit;
    sgresult1: TStringGrid;
    sgresult2: TStringGrid;
    sgresult3: TStringGrid;
    sgresult5: TStringGrid;
    sgresult6: TStringGrid;
    sgresult7: TStringGrid;
    sgresult8: TStringGrid;
    sb_info_details: TSpeedButton;
    SpeedButton3: TSpeedButton;
    semes_or: TSpinEdit;
    sewait_or: TSpinEdit;
    se_ping_size: TSpinEdit;
    se_ping_count: TSpinEdit;
    se_avirus_mess: TSpinEdit;
    se_avirus_wait: TSpinEdit;
    sp_orelay: TSplitter;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    TabSheet8: TTabSheet;
    TabSheet9: TTabSheet;
    tb_orinclude: TToggleBox;
    torelay: TSdfDataSet;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    tbstart: TToolButton;
    ToolButton2: TToolButton;
    eddomain: TEdit;
    edhost: TComboBox;
    edport: TEdit;
    eduserfrom: TEdit;
    GroupBox2: TGroupBox;
    ImageList1: TImageList;
    luserfrom: TLabel;
    ldomain: TLabel;
    lip: TLabel;
    MainMenu1: TMainMenu;
    menuhelp: TMenuItem;
    menu_topics: TMenuItem;
    MenuItem13: TMenuItem;
    menu_about: TMenuItem;
    menu_save: TMenuItem;
    MenuItem24: TMenuItem;
    menu_exit: TMenuItem;
    menutools: TMenuItem;
    menu_preferences: TMenuItem;
    menufile: TMenuItem;
    Panel1: TPanel;
    salvar: TSaveDialog;
    sbresolveip: TSpeedButton;
    sdflangs: TSdfDataSet;
    tbstop: TToolButton;
    tvor: TTreeView;
    xmlc: TXMLConfig;
    procedure ac_orelay_detailsExecute(Sender: TObject);
    procedure ac_recipExecute(Sender: TObject);
    procedure ac_resolvemxExecute(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image7Click(Sender: TObject);
    procedure Image8Click(Sender: TObject);
    procedure Image9Click(Sender: TObject);
    procedure acping_startExecute(Sender: TObject);
    procedure acping_stopExecute(Sender: TObject);
    procedure acspf_startExecute(Sender: TObject);
    procedure acdnsblExecute(Sender: TObject);
    procedure acdnsbl_stopExecute(Sender: TObject);
    procedure achelp_appExecute(Sender: TObject);
    procedure acinfo_stopExecute(Sender: TObject);
    procedure acinfoExecute(Sender: TObject);
    procedure acopenrelay_stopExecute(Sender: TObject);
    procedure acperform_stopExecute(Sender: TObject);
    procedure acperformExecute(Sender: TObject);
    procedure acshow_includeExecute(Sender: TObject);
    procedure acspamtest_stopExecute(Sender: TObject);
    procedure acupdatesExecute(Sender: TObject);
    procedure acvirustest_stopExecute(Sender: TObject);
    procedure acaboutExecute(Sender: TObject);
    procedure acexitExecute(Sender: TObject);
    procedure acpreferencesExecute(Sender: TObject);
    procedure acsaveExecute(Sender: TObject);
    procedure acspamtestExecute(Sender: TObject);
    procedure acopenrelayExecute(Sender: TObject);
    procedure acvirustestExecute(Sender: TObject);
    procedure edinfo_paramKeyPress(Sender: TObject; var Key: char);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure eddomainKeyPress(Sender: TObject; var Key: char);
    procedure edhostCloseUp(Sender: TObject);
    procedure edhostKeyPress(Sender: TObject; var Key: char);
    procedure pcontrol_resultChange(Sender: TObject);
    procedure sbresolveipClick(Sender: TObject);
    function  CambiaEn(Cadena, Esto, Por: String): String;
    Function  getfrom(fromdb,userext,domain,dom_ext,hostname,userloc,ip : String) : String;
    procedure sbresolvemxClick(Sender: TObject);
    Function  enable_button(Param : Boolean; Act : TAction): Boolean;
    procedure check_before_scan;
    procedure sb_orelay_detailsClick(Sender: TObject);
    procedure sb_includeClick(Sender: TObject);
    procedure se_avirus_waitChange(Sender: TObject);
    procedure sewait_orChange(Sender: TObject);
    Procedure show_include_dlg(dtbase : string);
    procedure load_strings;
    procedure checkboxes_check (Checkboxes : TCheckBox);
    procedure setfocus_memo(Memo : TMemo);
    procedure header_result(typhe : String; SG: TStringGrid);
    procedure bottom_result(SG: TStringGrid);
    procedure change_caption(Tab : TTabsheet);
    procedure fin_test(Tab : TTabsheet);
    procedure sb_info_detailsClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure tb_orincludeChange(Sender: TObject);
    procedure torelayBeforeInsert(DataSet: TDataSet);
    procedure tvorGetSelectedIndex(Sender: TObject; Node: TTreeNode);
  private
     procedure ORCbtn (Sender : TObject);
  public
    pathdb, pathfiles,pathimages, vrecipient : String;
    clflag_or : Boolean;
    procedure orelaygraph(image : Byte; descrip : String; explist : TStringList);
  end;

 var
  vtimeout : integer;
  fprincipal: Tfprincipal;
  fabout: Tfabout;
  finclude: Tfinclude;
  fpreferences: Tfpreferences;
  fdetails: Tfdetails;
  TestOrelay : Thorelay;
  TestVirus : Tvirus;
  TestSpam : Tspam;
  Testperf : Tperformance;
  TGinfo : Tinfo;
  fupdates: Tfupdates;
  Tresolve_mx : Tresolvemx;
  Tresolve_ip : Tresolvip;
  Tdnsbl_client : Tdnsbl;
  Tspf_buid : Tspf;
  Tpingc : TPingClient;
  frecipient: Tfrecipient;
  //temp var
  i   : Integer;

Const
ver = '0.4';


resourcestring
  rsFileNotFound = 'File not found ';
  rsNoValidIPAdd = 'No valid IP Address';
  rsPleaseComple = 'Please, complete all field';
  rsDate = 'Date: ';
  rsTheRemoteSer = 'The remote server not response';
  rsHelp = 'Help';
  rsDomain = 'Domain:';
  rsHostIP = 'Host IP:';
  rsUserTo = 'Recipient:';
  rsSpamEngine = 'Spam engine';
  rsSave = 'Export';
  rsGTUBETest = 'GTUBE test';
  rsGTUBETestIns = 'GTUBE test inside message';
  rsThisIsTheGTU = 'This is the GTUBE test';
  rsInsideMessaj = 'Inside messaje GTUBE test';
  rsSendOK = ' Send OK';
  rsProblem = '%s Problem:  ';
  rsOPENRELAYFou = '%s OPEN RELAY found:  ';
  rsMessagesSend = ' messages send OK';
  rsCongratulati = 'Congratulation, no open relay found';
  rsMailServers = 'MailServers:';
  rsResolveIP = 'Resolve IP';
  rsResolveMX = 'Resolve MX';
  rsNothingToSav = 'Nothing to save';
  rsIncludeOpenR = 'Include open relay test';
  rsIncludeVirus = 'Include virus test';
  rsElDestinatar = 'The recipient %s exist in the server?';
  rsPruebaOpenRe = 'OpenRelay Test';
  rsPruebaAntisp = 'Antispam Test';
  rsOpenRelayTes = 'Open relay test to: ';
  rsOnDomain = ' on domain: ';
  rsAntivirusTes = 'Antivirus test to: ';
  rsAntispamTest = 'Antispam test to: ';
  rsPerformanceT = 'Performance test to: ';
  rsInfoFrom = 'Info from: ';
  rsAbortByUser = 'Abort by user';
  rsTestPerforma = 'Test performance';
  rsPruebaAntivi = 'Antivirus Test';
  rsExit = 'Exit';
  rsTestComplete = 'Test completed';
  rsTypeOpenRela = 'Open relay test';
  rsWARNINGFound = 'WARNING Found: %s Open relay test';
  rsTypeVirusTes = 'Virus test';
  rsErrorToDecry = 'Error to Decrypt file';
  rsMessageWitho = ' message without send';
  rsSeeYouMailbo = 'See you mailbox %s in %s for details';
  rsTypeGTUBESpa = 'GTUBE spam test';
  rsGTUBESpamTes = 'GTUBE spam test';
  rsTypeGTUBESpa2 = 'GTUBE spam test inside';
  rsGTUBESpamTes2 = 'GTUBE spam test inside';
  rsTypePerforma = 'Performance test';
  rsFailedToAtta = 'Failed to attach file';
  rsMessageWithA = 'Message with attachment #: ';
  rsAttachment = 'Attachment: ';
  rsNothingToPri = 'Nothing to print';
  rsNotSupportSi = 'Not support size';
  rsWaitForResol = 'Wait for resolve';
  rsNotResolveMX = 'Cannot resolve MX for domain';
  rsHost = 'Host: ';
  rsSender = 'Sender:';
  rsMessages = 'Messages:';
  rsAttachmentSi = 'Attachment size:';
  rsFile = 'File';
  rsTests = 'Tests';
  rsTools = 'Tools';
  rsOpenRelay = 'Open relay';
  rsVirus = 'Virus';
  rsSpam = 'Spam';
  rsPerformance = 'Performance';
  rsPreferences = 'Preferences';
  rsTopics = 'Topics';
  rsUpdates = 'Updates';
  rsAbout = 'About...';
  rsAntivirus = 'Antivirus';
  rsAntispam = 'Antispam';
  rsInfo = 'Info';
  rsCannotResolv = 'Cannot resolve IP';
  rsDNSBLList = 'DNSBL List';
  rsDNSBLTo = 'DNSBL to: ';
  rsCongratulati2 = 'Congratulation, all test OK';
  rsDNSBLTest = 'DNSBL Test ';
  rsSendDnsQuery = 'Send dns query for: ';
  rsFound = 'Found: ';
  rsNotFound = 'Not found';
  rsNotFound2 = 'Not Found: ';
  rsFailure = 'Failure';
//---------0.3------------//
  rsMore = 'More';
  rsLess = 'Less';
  rsSPFSupport = 'SPF support: ';
  rsPingTest = 'Ping test: ';
  rsNotImplement = 'Not implemented yet';
  rsDomainSender = 'Domain sender may not be equal to the target domain';
  rsWaiting = 'Waiting ';
  rsSec = ' sec';
  rsGreyListingD = 'GreyListing detect or mailbox busy';
  rsInformationG = 'Information get';
  rsNotSPFRecord = 'Not SPF Record found';
  rsSPFSupport2 = 'SPF support';
  rsQueryDnsForS = 'Query dns for SPF record';
  rsPleaseTransf = 'Please, transfer these records to your DNS server';
  rsIfYouRunBIND = 'If you run BIND. Paste this into your zone file';
  rsIfYouRunTiny = 'If you run tinydns (djbdns)';
  rsIfYouRunWind = 'If you run Windows DNS';
  rsPleaseSeeHtt = 'Please see http://www.michaelbrumm.com/spfwindowsdns/';
  rsPingTest2 = 'Ping test';
  rsNoResponse = 'No response';
  rsYouAreRoot = 'You are root?';
  rsWait = 'Wait:';
  rsSize = 'Size:';
  rsCount = 'Count:';
  rsGlobalDns = 'Global dns';
  rsUseDns = 'Use dns:';
  rsStop = 'Stop';
  rsProperties = 'Properties';
  rsDelivery = 'Delivery';
  rsOptions = 'Options';
//---------0.4------------//



//------------end resource string-----------//

implementation


{ Tfprincipal }


//Show Include dialog (Unit uinclude)
Procedure Tfprincipal.show_include_dlg(dtbase : string);
var
  dbtpath : string;
begin
dbtpath:=pathdb+dtbase;
finclude := Tfinclude.Create(Self);
if FileExists(dbtpath) then
  Begin
  // finclude.torelay.FileName := dbtpath;
   //finclude.torelay.Active := True;
   if dtbase = 'dborelay.db' then
      Begin
       finclude.Caption := rsIncludeOpenR;
       finclude.ShowModal;
      end;
   if dtbase = 'virus.db' then
      Begin
       finclude.Caption := rsIncludeVirus;
       finclude.ShowModal;
      end;
   if dtbase = 'dnsbl.db' then
      Begin
       finclude.Caption := rsDNSBLList;
       finclude.ShowModal;
      end;
   finclude.ShowModal;
  end else
  ShowMessage(rsFileNotFound + dbtpath);
end;


//For export stringgrid to HTML
Procedure SGridToHtml(SG:Tstringgrid; Filename: TFileName; BorderSize:integer;
          Title : String);
var i,p:integer;
    SStyle1,SStyle2,Text:string;
    Dest : TStringList;
begin
  Dest := TStringList.Create;
  Dest.add('<html>');
  Dest.Add('<head><title>'+Title+'</title></head>');
  Dest.add('<body>');
  Dest.add(' <table cellpadding="0" cellspacing="0" border="'+
  inttostr(BorderSize)+'" width="'+inttostr(SG.Width)+'"');

  for i:=0 to SG.RowCount-1 do
  begin

    Dest.add('  <tr>');
    for p:=0 to SG.ColCount-1 do
    begin
      SStyle1:='';
      SStyle2:='';
      if fsbold in SG.Font.style then
      begin
        SStyle1:=SStyle1+'<b>';
        SStyle2:=SStyle2+'</b>';
      end;
      if fsitalic in SG.Font.style then
      begin
        SStyle1:=SStyle1+'<i>';
        SStyle2:=SStyle2+'</i>';
      end;
      if fsunderline in SG.Font.style then
      begin
        SStyle1:=SStyle1+'<u>';
        SStyle2:=SStyle2+'</u>';
      end;
      text:=sg.Cells[p,i];
      if text='' then
        text:=' ' ;
      If i = 1 then
         Dest.add('    <td width="'+inttostr(sg.ColWidths[p])+
                          '" height="'+inttostr(sg.RowHeights[p])+
                          '"><font color="#000000'+
                          '" face="'+SG.Font.Name+'">'+SStyle1+'<b>'+
                          text+'</b>'+SStyle2+'</font></td>')
      else
                                           
         Dest.add('    <td width="'+inttostr(sg.ColWidths[p])+
                          '" height="'+inttostr(sg.RowHeights[p])+
                          '"><font color="#000000'+
                          '" face="'+SG.Font.Name+'">'+SStyle1+
                          text+SStyle2+'</font></td>');
    end;
    Dest.add('  </tr>');
  end;
  Dest.add('  </table>');
  Dest.add('</body>');;
  Dest.add('</html>');
  Dest.SaveToFile(filename);
  Dest.Free;
end;

procedure Tfprincipal.FormCreate(Sender: TObject);
 var
  db_perf,db_orelay, slah : String;
  tperform : Tdbf;
begin
  //Var Init
  clflag_or := False;
  tperform := Tdbf.Create(nil);
  Application.Title:='SMTPUtils v.'+ver;
  Caption := Application.Title;
  {$IFDEF LINUX} //For Linux
   slah:='/';
  {$ENDIF}
  {$IFDEF WIN32} //For MS Windows
   slah:='\';
  {$ENDIF}
    pathdb:= ExtractFileDir(Application.ExeName)+slah+'db'+slah;
    pathfiles:= ExtractFileDir(Application.ExeName)+slah+'files'+slah;
    pathimages:=ExtractFileDir(Application.ExeName)+slah+'files'+slah+'images'+slah;
    iniconfig.IniFileName:=ExtractFileDir(Application.ExeName)+slah+'smtputils.ini';
    db_perf := pathdb+'perform.dbf';
    db_orelay := pathdb+'orelay.db';
    if FileExists(db_orelay) then
     Begin
      torelay.FileName := db_orelay;
      torelay.Active := True;
     end;
   if FileExists(db_perf) then
      Begin
        tperform.TableName := db_perf;
        tperform.Active := True;
        tperform.First;
        while not tperform.EOF do
         begin
          cbsize.Items.Add(tperform.FieldByName('SIZE').Value);
          tperform.Next;
         end;
        cbsize.ItemIndex := 0;
        tperform.Free;
      end
    else
      ShowMessage(rsFileNotFound + db_perf);
  load_strings;
end;

procedure Tfprincipal.eddomainKeyPress(Sender: TObject; var Key: char);
begin
  If Key = #13 then
     ac_resolvemx.Execute;
//     sbresolvemxClick(Sender);
end;

procedure Tfprincipal.edhostCloseUp(Sender: TObject);
begin
   sbresolveipClick(Sender);
end;

procedure Tfprincipal.edhostKeyPress(Sender: TObject; var Key: char);
begin
  If Key = #13 then
     sbresolveipClick(Sender);
end;

procedure Tfprincipal.pcontrol_resultChange(Sender: TObject);
begin
    case pcontrol_result.TabIndex of
     0 : begin
          tbstart.Action := acopenrelay;
          tbstop.Action := acopenrelay_stop;
//          acshow_include.Enabled := True;
//          tbpropert.Action := acshow_include;
          change_caption(pcontrol_result.Pages[0]);
         end;
     1 : begin
          tbstart.Action := acvirustest;
          tbstop.Action := acvirustest_stop;
  //        acshow_include.Enabled := True;
//          tbpropert.Action := acshow_include;
          change_caption(pcontrol_result.Pages[1]);
         end;
     2 : begin
          tbstart.Action := acspamtest;
          tbstop.Action := acspamtest_stop;
    //      acshow_include.Enabled := False;
          change_caption(pcontrol_result.Pages[2]);
         end;
     3 : begin
          tbstart.Action := acperform;
          tbstop.Action := acperform_stop;
      //    acshow_include.Enabled := False;
          change_caption(pcontrol_result.Pages[3]);
         end;
     4 : begin
          tbstart.Action := acinfo;
          tbstop.Action := acinfo_stop;
       //   acshow_include.Enabled := False;
          change_caption(pcontrol_result.Pages[4]);
         end;
     5 : begin
          tbstart.Action := acdnsbl;
          tbstop.Action := acdnsbl_stop;
        //  acshow_include.Enabled := True;
//          tbpropert.Action := acshow_include;
          change_caption(pcontrol_result.Pages[5]);
         end;
     6 : begin
          tbstart.Action := acspf_start;
        //  acshow_include.Enabled := False;
          change_caption(pcontrol_result.Pages[6]);
         end;
     7 : begin
          tbstart.Action := acping_start;
          tbstop.Action := acping_stop;
        //  acshow_include.Enabled := False;
          change_caption(pcontrol_result.Pages[7]);
         end;
    end;
 ToolBar1.Refresh;
end;


//Execute thread Open relay test
procedure Tfprincipal.acopenrelayExecute(Sender: TObject);
var
  ctest : integer;
begin
  if Length(vrecipient)=0 then
     ac_recip.Execute else
    begin
     //Rset control bar
     pcontrol_result.TabIndex := 0;
     ctest:=0;
     sdfcomun.FileName:=pathdb+'orelay.db';
     sdfcomun.Active:=True;
     if tvor.Items.Count >= 1 then
        tvor.Items.Clear;
     sdfcomun.First;
     while not sdfcomun.EOF do begin
      if sdfcomun.FieldByName('apply').Value = 1 then
         ctest:=ctest+1;
      sdfcomun.Next;
     end;
     check_before_scan;
     TestOrelay := Thorelay.Create(True,edhost.text,edport.text,eddomain.Text,
     ededomain.text,edip.Text,eduserfrom.Text,vrecipient,vtimeout,
     strtoint(semes_or.Caption),strtoint(sewait_or.caption),ctest);
     if Assigned(TestOrelay.FatalException) then
        raise TestOrelay.FatalException;
     enable_button(true,acopenrelay_stop);
     TestOrelay.Resume;
     sdfcomun.Active:=False;
    end;
end;

//Execute thread Spam test
procedure Tfprincipal.acspamtestExecute(Sender: TObject);
begin
  if Length(vrecipient)=0 then
     ac_recip.Execute else
    begin
     pcontrol_result.TabIndex := 2;
     check_before_scan;
     TestSpam := Tspam.Create(True,edhost.text,edport.text,eddomain.Text,
     edip.Text,eduserfrom.Text,vrecipient,ededomain.Text,vtimeout,rg1.ItemIndex);
     if Assigned(TestSpam.FatalException) then
        raise TestSpam.FatalException;
     TestSpam.Resume;
     enable_button(true,acspamtest_stop);
    end;
end;

//Show dialog Preferences (Unit uprefer)
procedure Tfprincipal.acpreferencesExecute(Sender: TObject);
begin
  fpreferences := Tfpreferences.Create(Self);
  fpreferences.ShowModal;
end;


//Action Save or Export to html file
procedure Tfprincipal.acsaveExecute(Sender: TObject);
begin
{  if salvar.Execute then
     begin
       case pcontrol_result.TabIndex of
        0: if sgresult.RowCount > 1 then
           SGridToHtml(sgresult, salvar.FileName, 0, rsOpenRelayTes+
           edip.Text+rsOnDomain+eddomain.Text) else
           ShowMessage(rsNothingToSav);
        1: if sgresult1.RowCount > 1 then
           SGridToHtml(sgresult1, salvar.FileName, 0, rsAntivirusTes+
           edip.Text+rsOnDomain+eddomain.Text) else
           ShowMessage(rsNothingToSav);
        2: if sgresult2.RowCount > 1 then
           SGridToHtml(sgresult2, salvar.FileName, 0, rsAntispamTest+
           edip.Text+rsOnDomain+eddomain.Text) else
           ShowMessage(rsNothingToSav);
        3: if sgresult3.RowCount > 1 then
           SGridToHtml(sgresult3, salvar.FileName, 0, rsPerformanceT+
           edip.Text+rsOnDomain+eddomain.Text) else
           ShowMessage(rsNothingToSav);
//        4: if sgresult4.RowCount > 1 then
  //         SGridToHtml(sgresult4, salvar.FileName, 0, rsInfoFrom+
    //       edip.Text+rsOnDomain+eddomain.Text) else
      //     ShowMessage(rsNothingToSav);
        5: if sgresult5.RowCount > 1 then
           SGridToHtml(sgresult5, salvar.FileName, 0, rsDNSBLTo+
           edip.Text) else
           ShowMessage(rsNothingToSav);
        6: if sgresult6.RowCount > 1 then
           SGridToHtml(sgresult6, salvar.FileName, 0, rsSPFSupport+
           edip.Text) else
           ShowMessage(rsNothingToSav);
        7: if sgresult7.RowCount > 1 then
           SGridToHtml(sgresult7, salvar.FileName, 0, rsPingTest+
           edip.Text) else
           ShowMessage(rsNothingToSav);
       end;
     end}
end;

//Action Exit application
procedure Tfprincipal.acexitExecute(Sender: TObject);
begin
  Close;
end;

//Show dialog About (Unit uabout)
procedure Tfprincipal.acaboutExecute(Sender: TObject);
begin
  fabout := Tfabout.Create(Self);
  fabout.ShowModal;
end;

//Terminate thread Spam Test
procedure Tfprincipal.acspamtest_stopExecute(Sender: TObject);
begin
  enable_button(True,acspamtest);
  enable_button(False,acspamtest_stop);
  TestSpam.Terminate;
end;

//Show dialog updates (Unit uupdates)
procedure Tfprincipal.acupdatesExecute(Sender: TObject);
begin
  fupdates := Tfupdates.Create(Self);
  fupdates.ShowModal;
end;

//Terminate thread Antivirus Test
procedure Tfprincipal.acvirustest_stopExecute(Sender: TObject);
begin
  enable_button(True,acvirustest);
  enable_button(False,acvirustest_stop);
  TestVirus.Terminate;
  fprincipal.pbvirus.Position := 0;
end;

//Terminate thread Open relay test
procedure Tfprincipal.acopenrelay_stopExecute(Sender: TObject);
begin
  enable_button(True,acopenrelay);
  enable_button(False,acopenrelay_stop);
  TestOrelay.Terminate;
  fprincipal.pborelay.Position := 0;
end;

//Execute thread information get
procedure Tfprincipal.acinfoExecute(Sender: TObject);
begin
  pcontrol_result.TabIndex := 4;
 // check_before_scan(sgresult4);
  TGinfo := Tinfo.Create(True,cb_info_etrn.Checked,cb_info_vrfy.Checked,
    cb_info_help.Checked,cb_info_expn.Checked,cb_info_size.Checked,
    cb_info_auth.Checked,cb_info_tls.Checked,cb_info_swver.Checked,edhost.text,edport.text,
    eddomain.Text,ededomain.text,edip.Text,ed_info_etrn.Text,ed_info_vrfy.text,
    ed_info_help.Text,ed_info_expn.Text,vtimeout);
     if Assigned(TGinfo.FatalException) then
        raise TGinfo.FatalException;
     TGinfo.Resume;
end;

//Terminate thread information get
procedure Tfprincipal.acinfo_stopExecute(Sender: TObject);
begin
  enable_button(True,acinfo);
  enable_button(False,acinfo_stop);
  TGinfo.Terminate;
end;

//Execute thread dnsbl test
procedure Tfprincipal.acdnsblExecute(Sender: TObject);
var
  setdns : Boolean;
begin
  pcontrol_result.TabIndex := 5;
  check_before_scan;
  if rbdns2.Checked then
     setdns := True else
     setdns := False;
  Tdnsbl_client := Tdnsbl.Create(True, setdns,edip.text, ed_pf_dnsbl.Text,vtimeout);
   if Assigned(Tdnsbl_client.FatalException) then
      raise Tdnsbl_client.FatalException;
      enable_button(true,acdnsbl_stop);
     Tdnsbl_client.Resume;
end;

procedure Tfprincipal.Image8Click(Sender: TObject);
begin
  checkboxes_check(cb_spf_all)
end;

procedure Tfprincipal.Image9Click(Sender: TObject);
begin
  checkboxes_check(cb_spf_a)
end;

procedure Tfprincipal.acping_startExecute(Sender: TObject);
begin
  pcontrol_result.TabIndex := 7;
  check_before_scan;
  Tpingc := TPingClient.Create(True, edip.Text,StrToInt(se_ping_count.Caption),
  StrToInt(se_ping_size.Caption));
   if Assigned(Tpingc.FatalException) then
      raise Tpingc.FatalException;
  Tpingc.Resume;
end;

procedure Tfprincipal.acping_stopExecute(Sender: TObject);
begin
  enable_button(True,acping_start);
  enable_button(False,acping_stop);
  Tpingc.Terminate;
  fprincipal.pbping.Position := 0;
end;

procedure Tfprincipal.acspf_startExecute(Sender: TObject);
begin
  pcontrol_result.TabIndex := 6;
  check_before_scan;
  Tspf_buid := Tspf.Create(True, cb_spf_a.Checked, cb_spf_mx.Checked,
  cb_spf_ptr.Checked, cb_spf_all.Checked, eddomain.Text,m_spf_a.Text,
  m_spf_mx.Text,m_spf_ipv4.Text,ed_spf_include.Text, 60000);
   if Assigned(Tspf_buid.FatalException) then
      raise Tspf_buid.FatalException;
//      enable_button(true,acdnsbl_stop);
     Tspf_buid.Resume;
end;

procedure Tfprincipal.Image3Click(Sender: TObject);
begin
  checkboxes_check(cb_spf_ptr)
end;

procedure Tfprincipal.Image7Click(Sender: TObject);
begin
  ed_spf_include.SetFocus;
end;

procedure Tfprincipal.Image2Click(Sender: TObject);
begin
  checkboxes_check(cb_spf_mx)
end;

procedure Tfprincipal.ac_resolvemxExecute(Sender: TObject);
begin
   Tresolve_mx := Tresolvemx.Create(True,eddomain.Text);
  if Assigned(Tresolve_mx.FatalException) then
        raise Tresolve_mx.FatalException;
     Tresolve_mx.Resume;
end;

procedure Tfprincipal.Image1Click(Sender: TObject);
begin

end;

procedure Tfprincipal.ac_recipExecute(Sender: TObject);
begin
  frecipient:= Tfrecipient.Create(self);
  frecipient.ShowModal;
end;

procedure Tfprincipal.ac_orelay_detailsExecute(Sender: TObject);
begin
  fdetails := Tfdetails.Create(self);
  fdetails.m_details.Lines.LoadFromFile(GetTempDir+'smtputils_orelay.txt');
  fdetails.ShowModal;
end;

//Terminate thread dnsbl test
procedure Tfprincipal.acdnsbl_stopExecute(Sender: TObject);
begin
  enable_button(True,acdnsbl);
  enable_button(False,acdnsbl_stop);
  Tdnsbl_client.Terminate;
  fprincipal.pbdnsbl.Position := 0;
end;

procedure Tfprincipal.achelp_appExecute(Sender: TObject);
begin
  ShowMessage(rsNotImplement);
end;

//Terminate thread performance test
procedure Tfprincipal.acperform_stopExecute(Sender: TObject);
begin
  enable_button(True,acperform);
  enable_button(False,acperform_stop);
  Testperf.Terminate;
  fprincipal.pbperf.Position := 0;
end;

//Execute thread performance test
procedure Tfprincipal.acperformExecute(Sender: TObject);
begin
  if Length(vrecipient)=0 then
     ac_recip.Execute else
    begin
     pcontrol_result.TabIndex := 3;
     check_before_scan;
     Testperf := Tperformance.Create(True,edhost.text,edport.text,eddomain.Text,
     ededomain.Text,edip.Text,eduserfrom.Text,vrecipient,cbsize.Text,
     vtimeout,strtoint(senmessages.caption));
     if Assigned(Testperf.FatalException) then
        raise Testperf.FatalException;
     Testperf.Resume;
     enable_button(true,acperform_stop);
    end;
end;

//Action show include dialog
procedure Tfprincipal.acshow_includeExecute(Sender: TObject);
begin

end;

//Execute thread antivirus test
procedure Tfprincipal.acvirustestExecute(Sender: TObject);
begin
  if Length(vrecipient)=0 then
     ac_recip.Execute else
    begin
     pcontrol_result.TabIndex := 1;
     check_before_scan;
     TestVirus := Tvirus.Create(True,edhost.text,edport.text,eddomain.Text,
     ededomain.Text,edip.Text,eduserfrom.Text,vrecipient,vtimeout,
     StrToInt(se_avirus_wait.Caption),StrToInt(se_avirus_mess.Caption));
     if Assigned(TestVirus.FatalException) then
        raise TestVirus.FatalException;
     TestVirus.Resume;
     enable_button(true,acvirustest_stop);
    end;
  end;


//Press enter key execute acinfo action
procedure Tfprincipal.edinfo_paramKeyPress(Sender: TObject; var Key: char);
begin
 If Key = #13 then
    acinfo.Execute;
end;

//Event close form
procedure Tfprincipal.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
   if not acopenrelay.Enabled then
       TestOrelay.Terminate;

   if not acvirustest.Enabled then
       TestVirus.Terminate;

   if not acspamtest.Enabled then
       TestSpam.Terminate;

   if not acperform.Enabled then
       TestSpam.Terminate;

   if not acinfo.Enabled then
       TGinfo.Terminate;
       
    if not acdnsbl.Enabled then
       Tdnsbl_client.Terminate;
end;

//Function change text for Open relay test
function Tfprincipal.CambiaEn(Cadena, Esto, Por: String): String;
  var
    aPos: Integer;
  begin
    aPos := Pos(Esto, Cadena);
    Result:= '';
    while (aPos <> 0) do begin
      Result := Result + Copy(Cadena, 1, aPos-1) + Por;
      Delete(Cadena, 1, aPos + Length(Esto)-1);
      aPos := Pos(Esto, Cadena);
    end;
    Result := Result + Cadena;
  end;

//Function for remplace text at Open relay test
Function Tfprincipal.getfrom(fromdb,userext,domain,dom_ext,hostname,userloc,ip : String) : String;
Begin
  Result := CambiaEn(fromdb,'$userloc',userloc);
  Result := CambiaEn(Result,'$domloc',domain);
  Result := CambiaEn(Result,'$hostname',hostname);
  Result := CambiaEn(Result,'$userext',userext);
  Result := CambiaEn(Result,'$domext',dom_ext);
  Result := CambiaEn(Result,'$ip',ip);
end;

//Execute thread for resolve MX
procedure Tfprincipal.sbresolvemxClick(Sender: TObject);
begin

end;

//Check params before scan execute
procedure Tfprincipal.check_before_scan;
begin
  if (edhost.text = '') or (edip.Text = '') or (eddomain.text = '') or
     (eduserfrom.text = '') then
    Begin
     ShowMessage(rsPleaseComple);
     edhost.SetFocus;
     abort
    end;

  if not IsIP(edip.text) then
    Begin
      ShowMessage(rsNoValidIPAdd);
      edip.SetFocus;
      abort
    end;
if ededomain.Text = eddomain.Text then
   Begin
      ShowMessage(rsDomainSender);
      ededomain.SetFocus;
      abort
    end;

 { if SG.RowCount > 1 then
     begin
      SG.Clear;
      SG.RowCount := 1
     end;}
    
end;

procedure Tfprincipal.sb_orelay_detailsClick(Sender: TObject);
begin
end;

procedure Tfprincipal.sb_includeClick(Sender: TObject);
begin

end;

procedure Tfprincipal.se_avirus_waitChange(Sender: TObject);
begin
  if se_avirus_wait.Value = 0 then
     se_avirus_mess.Enabled := False else
     se_avirus_mess.Enabled := True;
end;

procedure Tfprincipal.sewait_orChange(Sender: TObject);
begin
  if sewait_or.Value = 0 then
     semes_or.Enabled := False else
     semes_or.Enabled := True
end;


//Load strings for captions
procedure Tfprincipal.load_strings;
var
  conf_file,lang,dirlang : String;
begin
  xmlc.RootName := 'CONFIG';
  {$IFDEF LINUX} //For Linux
    conf_file := ExtractFileDir(Application.ExeName) +'/smtputil.xml';
    dirlang := ExtractFileDir(Application.ExeName) +'/language/';
   {$ENDIF}
     {$IFDEF WIN32} //For MS Windows
       conf_file := ExtractFileDir(Application.ExeName) + '\smtputil.xml';
       dirlang := ExtractFileDir(Application.ExeName) + '\language\';
     {$ENDIF}

  if FileExists(conf_file) then
      Begin
        xmlc.Filename := conf_file;
   //     xmlcon.FileName := conf_file;
        lang := xmlc.GetValue('MAIN/cblanguage_Text','en');
        vtimeout := xmlc.GetValue('MAIN/setimeout_Value',20000);
      end
    else
      ShowMessage(rsFileNotFound + conf_file);

 // ShowMessage(lang);
  lang := Copy(lang,Pos('[',lang)+1,2);
  TranslateUnitResourceStrings('uprinc',dirlang +'smtputil-%s.po',lang,'');
  //head main menu
  menufile.Caption := rsFile;
  menutest.Caption := rsTests;
  menutools.Caption := rsTools;
  menuhelp.Caption := rsHelp;
  //sub-menu main menu
   //menu File
   acsave.Caption :=rsSave;
   acexit.Caption := rsExit;
   //menu Test
   menu_open_relay.Caption := rsOpenRelay;
   menu_virus.Caption := rsVirus;
   menu_spam.Caption := rsSpam;
   menu_performance.Caption := rsPerformance;
   //menu Tools
   acpreferences.Caption := rsPreferences;
   //menu Help
   achelp_app.Caption := rsTopics;
   acupdates.Caption := rsUpdates;
   acabout.Caption := rsAbout;

   //ActionList
   acopenrelay_stop.Caption:=rsStop;
   acvirustest_stop.Caption:=rsStop;
   acspamtest_stop.Caption:=rsStop;
   acperform_stop.Caption:=rsStop;
   acinfo_stop.Caption:=rsStop;
   acdnsbl_stop.Caption:=rsStop;
   acping_stop.Caption:=rsStop;
//   acshow_include.Caption:=rsProperties;
   achelp_app.Caption:='Topics';
   
 //Main form
  //labels
  ldomain.Caption := rsDomain;
  lhost.Caption :=rsMailServers;
  lip.Caption :=rsHostIP;
  luserfrom.Caption := rsSender;
  lmessage.Caption := rsMessages;
  lsize.Caption := rsAttachmentSi;
  lmessage_or.Caption:=rsMessages;
  lmessage_av.Caption:=rsMessages;
  lwait_or.Caption:=rsWait;
  lwait_av.Caption:=rsWait;
  lsize_ping.Caption:=rsSize;
  lcount_ping.Caption:=rsCount;
  
  //buttons
  sbresolveip.Caption :=rsResolveIP;

  //Page control
  TabSheet3.Caption := rsOpenRelay;
  TabSheet4.Caption := rsAntivirus;
  TabSheet5.Caption := rsAntispam;
  TabSheet6.Caption := rsPerformance;
  TabSheet8.Caption := rsInfo;

  //RadioButtons SpamTest
  rg1.Caption := rsSpamEngine;
  rg1.Items.Clear;
  rg1.Items.Add(rsGTUBETest);
  rg1.Items.Add(rsGTUBETestIns);
  rg1.ItemIndex := 0;
  
  //RadioButtons
  rbdns1.Caption:=rsGlobalDns;
  rbdns2.Caption:=rsUseDns;
  
  //GroupBoxs
  gborelay.Caption:=rsDelivery;
  gbantivirus.Caption:=rsDelivery;
  gbping.Caption:=rsOptions;
  
end;

procedure Tfprincipal.checkboxes_check(Checkboxes: TCheckBox);
begin
  if Checkboxes.Checked = True then
     Checkboxes.Checked := False
  else Checkboxes.Checked := True
end;

procedure Tfprincipal.setfocus_memo(Memo: TMemo);
begin
  Memo.SetFocus;
end;


//Put header in Stringgrid
procedure Tfprincipal.header_result(typhe: String; SG: TStringGrid);
begin
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0,SG.RowCount-1] := typhe;
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0, SG.RowCount-1] := rsHost+' '+ edhost.Text;
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0,SG.RowCount-1] := rsDate + ' ' + datetostr(now)+' '+TimeToStr(time);
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0,SG.RowCount-1] := '';
end;

//Put bottom in Stringgrid
procedure Tfprincipal.bottom_result(SG: TStringGrid);
begin
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0,SG.RowCount-1] := '';
 SG.RowCount := SG.RowCount+1;
 SG.Cells[0, SG.RowCount-1] := rsTestComplete
end;

procedure Tfprincipal.change_caption(Tab: TTabsheet);
begin
 if copy(Tab.Caption,1,1) = '*' then
    tab.Caption := copy(Tab.Caption,2,Length(Tab.Caption))
end;

procedure Tfprincipal.fin_test(Tab: TTabsheet);
begin
  if pcontrol_result.TabIndex <> Tab.TabIndex then
     Tab.Caption := '*'+Tab.Caption;
end;

procedure Tfprincipal.sb_info_detailsClick(Sender: TObject);
begin
  fdetails := Tfdetails.Create(self);
  fdetails.m_details.Lines.LoadFromFile(GetTempDir+'smtputils_info.txt');
  fdetails.ShowModal;
end;

procedure Tfprincipal.SpeedButton1Click(Sender: TObject);
begin
end;

procedure Tfprincipal.tb_orincludeChange(Sender: TObject);
begin
 if tb_orinclude.Checked then
   begin
     gborelay.Height:=184;
     dbg_orinclude.Visible := True;
     sp_orelay.Visible:=True
   end else
   begin
     dbg_orinclude.Visible := False;
     gborelay.Height:=50;
     sp_orelay.Visible:=False
   end
end;

procedure Tfprincipal.torelayBeforeInsert(DataSet: TDataSet);
begin
  abort;
end;

procedure Tfprincipal.tvorGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
end;

procedure Tfprincipal.ORCbtn(Sender: TObject);
var
   cap : String;
begin
 cap:= inttostr((Sender as TSpeedButton).Tag);
 ShowMessage(cap);
end;

procedure Tfprincipal.orelaygraph(image : Byte; descrip: String; explist : TStringList);
var
 tnode,tnode1 : TTreeNode;
 i : integer;
begin
 tnode := tvor.Items.Add(nil,descrip);
 tnode.ImageIndex:=image;
 tnode.SelectedIndex:=image;
 if explist.Count >=1 then
   for i:=0 to explist.Count-1 do begin
     tnode1 := tvor.Items.AddChild(tnode,explist.Strings[i]);
     tnode1.ImageIndex:=9;
     tnode1.SelectedIndex:=9
   end;
end;

//Enable or disable Actions
Function Tfprincipal.enable_button(Param : Boolean; Act : TAction): Boolean;
begin
 Act.Enabled := Param;
 Result := Param
end;

//Execute thread resolve IP
procedure Tfprincipal.sbresolveipClick(Sender: TObject);
 begin
  Tresolve_ip := Tresolvip.Create(True,edhost.Text);
  if Assigned(Tresolve_ip.FatalException) then
        raise Tresolve_ip.FatalException;
     Tresolve_ip.Resume;
 end;


{ Torelay }
{ Implementation of Open relay test Thread }

procedure Thorelay.putresult_or;
begin
  filedetails.Add(Fresult);
end;

procedure Thorelay.putgraph;
begin
 fprincipal.orelaygraph(Fimage,Fdescrip,buildxgraph);
end;

procedure Thorelay.putincpb_or;
begin
 fprincipal.pborelay.Position := Fvalpb;
end;

procedure Thorelay.pb_maxpos;
begin
  fprincipal.pborelay.Max := Fpb_max;
end;

procedure Thorelay.genwarning;
begin
 MessageDlg('Warning Open Relay',inttostr(hole)+' hole(s) have been found',mtWarning,[mbOK],'');
end;

procedure Thorelay.Execute;
var
 dborelay : String;
 i, numess : Integer;
begin
  fprincipal.enable_button(false, fprincipal.acopenrelay);
  fprincipal.enable_button(false,fprincipal.ac_orelay_details);
  fprincipal.pb_orelay_status.Style:=pbstMarquee;
  //initialization var
  numess:=0;
  hole := 0;
  secur := 0;
  smtp.Timeout := Ftimeout;
  buildxgraph := TStringList.Create;
  Fdescrip:=rsTypeOpenRela;
  Fimage:=-1;
  buildxgraph.Add('Host: '+Fhost);
  buildxgraph.Add('IP :'+Fip);
  buildxgraph.Add('Domain: '+FSystemN);
  Synchronize(@putgraph);
  dborelay := fprincipal.pathdb+'orelay.db';
  if FileExists(dborelay) then
      Begin
        table.FileName := dborelay;
        table.FirstLineAsSchema:=True;
        table.Delimiter:='|';
        table.Active := True;
        Fpb_max := Fctest;
        Synchronize(@pb_maxpos)
      end
    else
      Begin
       Fresult := rsFileNotFound + dborelay;
       Synchronize(@putresult_or);
      end;
  i := 0;
  table.First;
  while not table.EOF do
  Begin
   if not Terminated then
   begin
     i := i + 1;
     header.Clear;
     mens_header.Clear;
     if table.FieldByName('apply').Value = 1 then
      Begin
      header.XMailer := fprincipal.xmlc.GetValue('MAIN/edmailer_Text','');
      header.From := fprincipal.getfrom(table.FieldByName('from').Value,
      Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip);
      header.ToList.Add(fprincipal.getfrom(table.FieldByName('from').Value,
      Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip));
      header.Subject := table.FieldByName('descript').Value;
      header.EncodeHeaders(mens_header);
      smtp.TargetHost := Fip;
      smtp.TargetPort := Fport;
      smtp.SystemName := fprincipal.getfrom(table.FieldByName('helo').Value,
      Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip);
      if smtp.Login then
         Begin
          Fresult := table.FieldByName('descript').Value;
          Synchronize(@putresult_or);
          Fdescrip := Fresult;
          smtp.MailFrom(fprincipal.getfrom(table.FieldByName('from').Value,
          Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip),100);
          Fresult := '---> MAIL FROM: '+fprincipal.getfrom(table.FieldByName('from').Value,
          Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip);
          Synchronize(@putresult_or);
          buildxgraph.Add(Fresult);
          Fresult := '<--- '+smtp.ResultString;
          Synchronize(@putresult_or);
          buildxgraph.Add(Fresult);
          smtp.MailTo(fprincipal.getfrom(table.FieldByName('to').Value,
          Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip));
          Fresult := '---> MAIL TO: '+fprincipal.getfrom(table.FieldByName('to').Value,
          Fuserext,FSystemN,Fdomain_ext,Fhost,Fuserloc,Fip);
          Synchronize(@putresult_or);
          buildxgraph.Add(Fresult);
          Fresult := '<--- '+smtp.ResultString;
          Synchronize(@putresult_or);
          buildxgraph.Add(Fresult);
          smtp.MailData(mens_header);
          numess:= numess+1; //incremental messages variable
          if smtp.ResultCode = 250 then
           Begin
            Fresult := Format(rsOPENRELAYFou, ['"']) + smtp.ResultString;
            Synchronize(@putresult_or);
            Fresult := '';
            Synchronize(@putresult_or);
            hole := hole + 1;
            Fimage:=6;
            Synchronize(@putgraph);
           end;
         if (smtp.ResultCode >=500) and (smtp.ResultCode <=554) then
          begin
            Fresult :='OK '+smtp.ResultString;
            Synchronize(@putresult_or);
            Fresult := '';
            Synchronize(@putresult_or);
            secur := secur+1;
            Fimage:=7;
            Synchronize(@putgraph);
          end;
        end else
            Begin
             Fresult := Fhost+' '+rsTheRemoteSer;
             Synchronize(@putresult_or);
            end;
      end;
   end else
   begin
    Fresult := rsAbortByUser;
    Synchronize(@putresult_or);
    break
   end;
   table.Next;
   Fvalpb := table.RecNo;
   buildxgraph.Clear;
   Synchronize(@putincpb_or);
   if (numess = Fmess) and not (table.EOF) then
      Begin
        if Fwait <> 0 then
          begin
           Fresult := '';
           Synchronize(@putresult_or);
           Fresult := rsWaiting+inttostr(Fwait)+rsSec;
           Synchronize(@putresult_or);
           Fresult := '';
           Synchronize(@putresult_or);
           Sleep(Fwait*1000); //Wait for next connect
          end;
        numess:=0; //Reset numess
      end;
  end; //End of table
  Fdescrip:='Holes(s): '+IntToStr(hole)+' Security: '+IntToStr(secur)+
  ' Total: '+IntToStr(Fpb_max);
  Fimage:=-1;
  Synchronize(@putgraph);
  if hole >= 1 then
     Begin
      Fresult := Format(rsWARNINGFound, [inttostr(hole)]);
      Synchronize(@putresult_or);
      Synchronize(@genwarning);
      Fdescrip:= Format(rsWARNINGFound, [inttostr(hole)]);
      Fimage:=-1;
      Synchronize(@putgraph);
     end;
  if (secur >=1) and (hole = 0) then
     Begin
      Fresult := rsCongratulati;
      Fdescrip:= rsCongratulati;
      Fimage:=-1;
      Synchronize(@putgraph);
      Synchronize(@putresult_or);
     end;
  smtp.free;
//  fprincipal.bottom_result(fprincipal.sgresult);
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[0]);
  filedetails.SaveToFile(GetTempDir+'smtputils_orelay.txt');
  header.free;
  mens_header.free;
  filedetails.Free;
  buildxgraph.Free;
  fprincipal.enable_button(true,fprincipal.acopenrelay);
  fprincipal.enable_button(False,fprincipal.acopenrelay_stop);
  fprincipal.enable_button(True,fprincipal.ac_orelay_details);
    fprincipal.pb_orelay_status.Style:=pbstNormal;
  Fvalpb := 0;
  Synchronize(@putincpb_or);
  table.Active := False;
end;

constructor Thorelay.Create(CreateSuspended: Boolean; Ahost, Aport, AsystemN,Adomain_ext,
  Aip,Auserext,Auserloc: String; Atimeout,messa,wait,Actest: integer);
begin
  mens_header := TStringList.Create;
  filedetails := TStringList.Create;
  buildxgraph := TStringList.Create;
  header := TMessHeader.Create;
  smtp := TSMTPSend.Create;
  table := TSdfDataSet.Create(nil);
  Fhost := Ahost;
  Fport := Aport;
  Fmess:=messa;
  Fwait:=wait;
  Fdomain_ext := Adomain_ext;
  FSystemN:= AsystemN;
  Fip := Aip;
  Fctest:=Actest;
  Ftimeout := Atimeout;
  Fuserext := Auserext;
  Fuserloc := Auserloc;
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

{ Tvirus }
{ Implementation of Antivirus test Thread }

procedure Tvirus.putresult_vt;
begin
 fprincipal.sgresult1.RowCount := fprincipal.sgresult1.RowCount+1;
 fprincipal.sgresult1.Cells[0,fprincipal.sgresult1.RowCount-1] := Fresult;
end;

procedure Tvirus.putincpb_vt;
begin
  fprincipal.pbvirus.Position := Fvapb;
end;

procedure Tvirus.Execute;
var
 i, fail, send, numess               : integer;
 path_files, dbvirus, KeyStr : String;
 Source                      : TFileStream;
 Dest                        : TMemoryStream;
 Store_file                  : TStringList;
begin
  fprincipal.enable_button(false,fprincipal.acvirustest);
  fail := 0;
  send := 0;
  numess:= 0;
  smtp.Timeout := Ftimeout;
  smtp.TargetHost := Fip;
  smtp.TargetPort := Fport;
  smtp.SystemName := FSystemN;
  fprincipal.header_result(rsTypeVirusTes, fprincipal.sgresult1);
  i := 0;
     path_files := fprincipal.pathfiles;
     dbvirus := fprincipal.pathdb+'virus.dbf';
  if FileExists(dbvirus) then
      Begin
        table.TableName := dbvirus;
        table.Active := True
      end
    else
      Begin
       Fresult := rsFileNotFound + dbvirus;
       Synchronize(@putresult_vt);
      end;
  table.First;
  fprincipal.pbvirus.Max := table.RecordCount;
  while not table.EOF do
   Begin
    if not Terminated then
    begin
     if table.FieldByName('APPLY').Value = True then
      begin
        i := i + 1;
        try
         Source:= TFileStream.Create(path_files+
         table.FieldByName('FILENAME').Value,fmOpenRead);
         Dest:= TMemoryStream.Create;
         Store_file := TStringList.Create;
         KeyStr := 'rety578oiudf';
         Cipher.InitStr(KeyStr,TDCP_sha512);
         Cipher.DecryptStream(Source,Dest,Source.Size);
         Cipher.Burn;
         Source.Free;
        except
         Fresult := rsErrorToDecry;
         Synchronize(@putresult_vt);
        end;
       mbody.Clear;
       mens_text.Clear;
       mime.Clear;
       Mime := Mbody.AddPartMultipart('mixed', nil);
       mbody.Header.From := Fuserfrom +'@'+Fdomain_ext;
       mbody.Header.Subject := table.FieldByName('DESCRIPT').Value;
       mbody.Header.ToList.Add(Fuserto+'@'+FSystemN);
       mbody.Header.XMailer := fprincipal.xmlc.GetValue('MAIN/edmailer_Text','');
       mens_text.Add(#13);
       mens_text.Add(table.FieldByName('DESCRIPT').Value);
       mbody.AddPartText(mens_text,Mime);
       if table.FieldByName('FORMAT').Value = 'TXT' then
          begin
           Dest.Position := 0;
           Store_file.LoadFromStream(Dest);
           mbody.AddPartText(Store_file,Mime);
          end;
       if table.FieldByName('FORMAT').Value = 'BIN' then
          mbody.AddPartBinary(Dest, copy(table.FieldByName('FILENAME').Value,1,
          Length(table.FieldByName('FILENAME').Value)-3), Mime);
        if table.FieldByName('FORMAT').Value = 'HTML' then
           Begin
            Dest.Position := 0;
            Store_file.LoadFromStream(Dest);
            mbody.AddPartHTML(Store_file,Mime);
           end;
       Dest.Free;
       Store_file.Free;
       mbody.EncodeMessage;
       if smtp.Login then
       begin
         Fresult := table.FieldByName('DESCRIPT').Value;
         Synchronize(@putresult_vt);
         smtp.MailFrom(Fuserfrom + '@'+Fdomain_ext,100);
         Fresult := '---> MAIL FROM: '+Fuserfrom + '@'+Fdomain_ext;
         Synchronize(@putresult_vt);
         Fresult := '<--- '+smtp.ResultString;
         Synchronize(@putresult_vt);
         smtp.MailTo(Fuserto+'@'+FSystemN);
         Fresult := '---> MAIL TO: '+Fuserto + '@'+FSystemN;
         Synchronize(@putresult_vt);
         Fresult := '<--- '+smtp.ResultString;
         Synchronize(@putresult_vt);
         if (smtp.ResultCode = 450) or (smtp.ResultCode = 451) then
            begin
            // fail := fail+1;
             Fresult := '';
             Synchronize(@putresult_vt);
             Fresult := rsGreyListingD;
             Synchronize(@putresult_vt);
             Fresult := '';
             Synchronize(@putresult_vt);
             break
            end;
         smtp.MailData(mbody.Lines);
         if smtp.ResultCode = 250 then
            begin
             Fresult := rsSendOK;
             Synchronize(@putresult_vt);
             Fresult := '';
             Synchronize(@putresult_vt);
             send := send+1;
            end
         else
            begin
             Fresult := Format(rsProblem, ['"']) + smtp.ResultString;
             Synchronize(@putresult_vt);
             Fresult := '';
             Synchronize(@putresult_vt);
             fail := fail+1;
            end;
       numess:= numess+1; //incremental messages variable
       end else //Login failed
       begin
         Fresult := Fhost+' '+rsTheRemoteSer;
         Synchronize(@putresult_vt);
       end;
   end;
   //End apply
   end else
   //Aborted by user
      begin
         Fresult := rsAbortByUser;
         Synchronize(@putresult_vt);
         break
       end;
     table.Next;
     Fvapb := table.RecNo;
     Synchronize(@putincpb_vt);
     if (numess = Fmess) and not (table.EOF) then
       Begin
        if Fwait <> 0 then
          begin
           Fresult := '';
           Synchronize(@putresult_vt);
           Fresult := rsWaiting+inttostr(Fwait)+rsSec;
           Synchronize(@putresult_vt);
           Fresult := '';
           Synchronize(@putresult_vt);
           Sleep(Fwait*1000); //Wait for next connect
          end;
        numess:=0; //Reset numess
       end;
  end;
  //End while
    if fail >= 1 then
      Begin
       Fresult := inttostr(Fail)+rsMessageWitho;
       Synchronize(@putresult_vt);
      end;
    if send >= 1 then
      Begin
       Fresult := inttostr(i)+rsMessagesSend;
       Synchronize(@putresult_vt);
      end;
    if  fail < i then
      begin
       Fresult := Format(rsSeeYouMailbo, [Fuserto, FSystemN]);
       Synchronize(@putresult_vt);
      end;
  fprincipal.bottom_result(fprincipal.sgresult1);
  smtp.free;
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[1]);
  mbody.Free;
  mens_text.Free;
  table.Free;
  fprincipal.enable_button(True,fprincipal.acvirustest);
  fprincipal.enable_button(False,fprincipal.acvirustest_stop);
  Fvapb := 0;
  Synchronize(@putincpb_vt);
  Cipher.Free;
end;

constructor Tvirus.Create(CreateSuspended: Boolean; Ahost, Aport, AsystemN,
Adomain_ext,Aip, Auserfrom, Auserto : String; Atimeout,Await,Amess: integer);
begin
    Fhost := Ahost;
    Fport := Aport;
    FSystemN := AsystemN;
    Fdomain_ext := Adomain_ext;
    Ftimeout := Atimeout;
    smtp := TSMTPSend.Create;
    Fip := Aip;
    Fuserfrom := Auserfrom;
    Fuserto := Auserto;
    Fwait:= Await;
    Fmess:= Amess;
    mens_text := TstringList.Create;
    mime := TMimePart.Create;
    mbody := TMimeMess.Create;
    table := Tdbf.Create(nil);
    Cipher:= TDCP_rc4.Create(nil);
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;

{ Tspam }
{ Implementation of Spam Test Thread }
procedure Tspam.putresult_st;
begin
 fprincipal.sgresult2.RowCount := fprincipal.sgresult2.RowCount+1;
 fprincipal.sgresult2.Cells[0,fprincipal.sgresult2.RowCount-1] := Fresult;
end;

procedure Tspam.Execute;
var
  fail : Integer;
  path_file : String;
begin
  fail := 0;
  path_file := fprincipal.pathfiles;
  smtp.TargetHost := Fip;
  smtp.TargetPort := Fport;
  smtp.SystemName := FSystemN;
  smtp.Timeout := Ftimeout;
  fprincipal.enable_button(false,fprincipal.acspamtest);
 case Fcateg of
     0: Begin   //Simple test GTUBE message
        fprincipal.header_result(rsTypeGTUBESpa, fprincipal.sgresult2);
         if smtp.Login then
            Begin
             mbody.Clear;
             mes_text.Clear;
             mbody.Header.From := Fuserfrom+'@'+Fdomain_ext;
             mbody.Header.Subject := rsGTUBETest;
              mbody.Header.ToList.Add(Fuserto+'@'+FSystemN);
              mbody.Header.XMailer := fprincipal.xmlc.GetValue('MAIN/edmailer_Text','');
                mes_text.Add(rsThisIsTheGTU);
                mes_text.Add(#13);
                mes_text.Add('XJS*C4JDBQADN1.NSBN3*2IDNEN*GTUBE-STANDARD-ANTI-UBE-TEST-EMAIL*C.34X');
              mbody.AddPartText(mes_text,nil);
             mbody.EncodeMessage;
              Fresult := rsGTUBESpamTes;
              Synchronize(@putresult_st);
              Fresult :='---> MAIL FROM: '+Fuserfrom+'@'+Fdomain_ext;
              Synchronize(@putresult_st);
              smtp.MailFrom(Fuserfrom+'@'+Fdomain_ext,100);
              Fresult := '<--- '+smtp.ResultString;
              Synchronize(@putresult_st);
              Fresult :='---> MAIL TO: '+Fuserto+'@'+FSystemN;
              Synchronize(@putresult_st);
              smtp.MailTo(Fuserto+'@'+FSystemN);
              Fresult := '<--- '+smtp.ResultString;
              Synchronize(@putresult_st);
             if smtp.ResultCode = 450 then
               begin
                  Fresult := '';
                  Synchronize(@putresult_st);
                  fail := fail+1;
                  Fresult := rsGreyListingD;
                  Synchronize(@putresult_st);
                  Fresult := '';
                  Synchronize(@putresult_st);
               end else
             smtp.MailData(mbody.Lines);
             if smtp.ResultCode = 250 then
               begin
                  Fresult := rsGTUBETest+'--> '+rsSendOK;
                  Synchronize(@putresult_st);
                  Fresult := Format(rsSeeYouMailbo, [Fuserto, FSystemN]);
                  Synchronize(@putresult_st);
               end
             else
               begin
                  fail := fail+1;
                  Fresult := Format(rsProblem, ['"']) + smtp.ResultString;
                  Synchronize(@putresult_st);
               end;
            end else
                 begin
                   Fresult := Fhost+' '+rsTheRemoteSer;
                   Synchronize(@putresult_st);
                 end;
          end;
     1: Begin    //Test Spam by GTUBE inside message
         fprincipal.header_result(rsTypeGTUBESpa2, fprincipal.sgresult2);
         if smtp.Login then
            Begin
             mbody.Clear;
             mes_text.Clear;
             Mime.Clear;
             Mime := Mbody.AddPartMultipart('mixed', nil);
             mbody.AddPartMessFromFile(path_file + 'gtube.txt', Mime);
             mbody.Header.From := Fuserfrom+'@'+Fdomain_ext;
             mbody.Header.Subject := rsGTUBETestIns;
              mbody.Header.ToList.Add(Fuserto+'@'+FSystemN);
              mbody.Header.XMailer := fprincipal.xmlc.GetValue('MAIN/edmailer_Text','');
                mes_text.Add(rsThisIsTheGTU);
                mes_text.Add(rsInsideMessaj);
              mbody.AddPartText(mes_text,Mime);
             mbody.EncodeMessage;
             Fresult := rsGTUBESpamTes2;
              Synchronize(@putresult_st);
              Fresult :='---> MAIL FROM: '+Fuserfrom+'@'+Fdomain_ext;
              Synchronize(@putresult_st);
              smtp.MailFrom(Fuserfrom+'@'+Fdomain_ext,100);
              Fresult := '<--- '+smtp.ResultString;
              Synchronize(@putresult_st);
              Fresult :='---> MAIL TO: '+Fuserto+'@'+FSystemN;
              Synchronize(@putresult_st);
              smtp.MailTo(Fuserto+'@'+FSystemN);
              Fresult := '<--- '+smtp.ResultString;
              Synchronize(@putresult_st);
              if smtp.ResultCode = 450 then
               begin
                  Fresult := '';
                  Synchronize(@putresult_st);
                  fail := fail+1;
                  Fresult := rsGreyListingD;
                  Synchronize(@putresult_st);
                  Fresult := '';
                  Synchronize(@putresult_st);
               end else
             smtp.MailData(mbody.Lines);
             if smtp.ResultCode = 250 then
               begin
                  Fresult := rsGTUBETestIns+'--> '+rsSendOK;
                  Synchronize(@putresult_st);
                  Fresult := Format(rsSeeYouMailbo, [Fuserto, FSystemN]);
                  Synchronize(@putresult_st);
               end
             else
               begin
                  fail := fail+1;
                  Fresult := Format(rsProblem, ['"']) + smtp.ResultString;
                  Synchronize(@putresult_st);
               end;
            end else
                  begin
                   Fresult := Fhost+' '+rsTheRemoteSer;
                   Synchronize(@putresult_st);
                 end;
        end;
end;
  fprincipal.bottom_result(fprincipal.sgresult2);
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[2]);
  fprincipal.enable_button(True,fprincipal.acspamtest);
  fprincipal.enable_button(False,fprincipal.acspamtest_stop);
  smtp.free;
  mbody.Free;
  mes_text.Free;
end;

constructor Tspam.Create(CreateSuspended: Boolean; Ahost, Aport, AsystemN, Aip,
  Auserfrom, Auserto, Adomain_ext: String; Atimeout, Acateg: integer);
begin
    Fhost := Ahost;
    Fport := Aport;
    FSystemN := AsystemN;
    Ftimeout := Atimeout;
    Fdomain_ext := Adomain_ext;
    smtp := TSMTPSend.Create;
    Fip := Aip;
    Fuserfrom := Auserfrom;
    Fuserto := Auserto;
    mes_text := TstringList.Create;
    mime := TMimePart.Create;
    mbody := TMimeMess.Create;
    Fcateg := Acateg;
    inherited Create(CreateSuspended);
end;

{ Tperformance }
{ Implementation of Performance test Thread }

procedure Tperformance.putresult_p;
begin
 fprincipal.sgresult3.RowCount := fprincipal.sgresult3.RowCount+1;
 fprincipal.sgresult3.Cells[0,fprincipal.sgresult3.RowCount-1] := Fresult;
end;

procedure Tperformance.putincpb_p;
begin
 fprincipal.pbperf.Position := Fvalpb;
end;

procedure Tperformance.Execute;
var
 i, fail, send : integer;
 path_files, db_perf : String;
 file_stream : TMemoryStream;
begin
  fail := 0;
  send := 0;
  smtp.Timeout := Ftimeout;
  fprincipal.header_result(rsTypePerforma, fprincipal.sgresult3);
  i := 0;
  path_files := fprincipal.pathfiles;
  db_perf := fprincipal.pathdb+'perform.dbf';
  if FileExists(db_perf) then
      Begin
        table.TableName := db_perf;
        table.Active := True
      end
    else
      Begin
       Fresult := rsFileNotFound + db_perf;
       Synchronize(@putresult_p);
      end;
  smtp.TargetHost := Fip;
  smtp.TargetPort := Fport;
  smtp.SystemName := FSystemN;
  smtp.Timeout := Ftimeout;
 if smtp.Login then
   Begin
     fprincipal.pbperf.Max := Fcount;
       try
        file_stream := TMemoryStream.Create;
        table.Locate('SIZE',Fsize,[loCaseInsensitive]);
        file_stream.LoadFromFile(path_files+table.FieldByName('FILENAME').Value);
       except
        Fresult := rsFailedToAtta;
        Synchronize(@putresult_p);
       end;
    for i := 1 to Fcount do
    begin
    if not Terminated then
     begin
      mbody.Clear;
      mens_text.Clear;
      mime.Clear;
      Mime := Mbody.AddPartMultipart('mixed', nil);
      mbody.Header.From := Fuserfrom +'@'+Fdomain_ext;
      mbody.Header.Subject := rsMessageWithA+inttostr(i);
      mbody.Header.ToList.Add(Fuserto+'@'+FSystemN);
      mbody.Header.XMailer := fprincipal.xmlc.GetValue('MAIN/edmailer_Text','');
      mens_text.Add(#13);
      mens_text.Add(table.FieldByName('DESCRIPT').Value);
      mbody.AddPartText(mens_text,Mime);
      mbody.AddPartBinary(file_stream,'attachment.dat',Mime);
      mbody.EncodeMessage;
      Fresult := rsMessageWithA+inttostr(i);
      Synchronize(@putresult_p);
      smtp.MailFrom(Fuserfrom + '@'+Fdomain_ext,100);
      Fresult := '---> MAIL FROM: '+Fuserfrom + '@'+Fdomain_ext;
      Synchronize(@putresult_p);
      Fresult := '<--- '+smtp.ResultString;
      Synchronize(@putresult_p);
      smtp.MailTo(Fuserto+'@'+FSystemN);
      Fresult := '---> MAIL TO: '+Fuserto + '@'+FSystemN;
      Synchronize(@putresult_p);
      Fresult := '<--- '+smtp.ResultString;
      Synchronize(@putresult_p);
      if smtp.ResultCode = 450 then
         begin
           Fresult := '';
           Synchronize(@putresult_p);
           fail := fail+1;
           Fresult := rsGreyListingD;
           Synchronize(@putresult_p);
           Fresult := '';
           Synchronize(@putresult_p);
           break
         end else
      smtp.MailData(mbody.Lines);
      if smtp.ResultCode = 250 then
         begin
          send := send+1;
          Fresult := rsMessageWithA+inttostr(i)+' --> '+rsSendOK;
          Synchronize(@putresult_p);
          Fresult := '';
          Synchronize(@putresult_p);
         end
      else
        begin
         Fresult := rsAttachment + Format(rsProblem, ['"']) +
         smtp.ResultString;
         Synchronize(@putresult_p);
         Fresult := '';
         Synchronize(@putresult_p);
         fail := fail+1;
        end;
      smtp.Reset;
     Fvalpb := i;
     Synchronize(@putincpb_p);
    end
     else
     begin
      Fresult := rsAbortByUser;
      Synchronize(@putresult_p);
      break
     end
   end;
   end else
       begin
         Fresult := Fhost+' '+rsTheRemoteSer;
         Synchronize(@putresult_p);
       end;
     if fail >= 1 then
        Begin
          Fresult := inttostr(Fail)+rsMessageWitho;
          Synchronize(@putresult_p);
        end else
        Begin
          Fresult := inttostr(send)+rsMessagesSend;
          Synchronize(@putresult_p);
        end;
        if  fail < i then
           begin
             Fresult := Format(rsSeeYouMailbo, [Fuserto, FSystemN]);
             Synchronize(@putresult_p);
           end;
        fprincipal.bottom_result(fprincipal.sgresult3);
  smtp.free;
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[3]);
  mbody.Free;
  mens_text.Free;
  file_stream.Free;
  table.Free;
  fprincipal.enable_button(True,fprincipal.acperform);
  fprincipal.enable_button(False,fprincipal.acperform_stop);
  Fvalpb := 0;
  Synchronize(@putincpb_p);
end;

constructor Tperformance.Create(CreateSuspended: Boolean; Ahost, Aport,
  AsystemN, Adomain_ext, Aip, Auserfrom, Auserto, Asize: String; Atimeout, Acount: integer);
begin
  Fhost := Ahost;
  Fport := Aport;
  FSystemN := AsystemN;
  Fdomain_ext := Adomain_ext;
  Ftimeout := Atimeout;
  Fcount := Acount;
  smtp := TSMTPSend.Create;
  Fip := Aip;
  Fsize := Asize;
  Fuserfrom := Auserfrom;
  Fuserto := Auserto;
  mens_text := TstringList.Create;
  mime := TMimePart.Create;
  mbody := TMimeMess.Create;
  table := Tdbf.Create(nil);
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;


{ Tinfo }
{ Implementation of Information get Thread }

procedure Tinfo.putresult_info;
begin
 filedetails.Add(Fresult);
// fprincipal.sgresult4.RowCount := fprincipal.sgresult4.RowCount+1;
// fprincipal.sgresult4.Cells[0,fprincipal.sgresult4.RowCount-1] := Fresult;
end;

procedure Tinfo.valid_resp(value: TStringList);
var
   recrd : integer;
begin
if value.Count >= 1 then
   begin
    for recrd := 0 to value.Count-1 do
     begin
      Fresult := value.Strings[recrd];
      Synchronize(@putresult_info);
     end
   end else
   begin
    Fresult := rsNothingToPri;
    Synchronize(@putresult_info);
   end;
   value.Clear;
end;

procedure Tinfo.showlogo;
begin
 if FileExists(fprincipal.pathimages+filelogo) then
 fprincipal.im_info_product.Picture.LoadFromFile(fprincipal.pathimages+filelogo);
 fprincipal.im_info_product.Hint:=logourl;
 fprincipal.sb_info_url.Caption:=logourl;
 fprincipal.lb_info_product.Caption:=product_info+' '+product_ver;
 fprincipal.lb_info_host.Caption:=product_host;
 fprincipal.lb_info_os.Caption:=product_os;
 fprincipal.lb_info_size.Caption:=product_size;
end;

procedure Tinfo.Execute;
var
  value : TStringList;
  value_temp, respsmtp, banner, rehelp : String;
begin
  value := TStringList.Create;
  fprincipal.enable_button(false, fprincipal.acinfo);
  smtp.TargetHost := Fip;
  smtp.TargetPort := Fport;
  smtp.SystemName := FSystemN;
  smtp.Timeout := Ftimeout;
  Fresult := rsInformationG;
  Synchronize(@putresult_info);
//  fprincipal.header_result(rsInformationG, fprincipal.sgresult4);
  if smtp.Login then
      Begin
        if Fcb_etrn = True then
           begin
            Fresult := '';
            Synchronize(@putresult_info);
            Fresult := '***ETRN response***';
            Synchronize(@putresult_info);
            smtp.Etrn(Fed_etrn);
            valid_resp(smtp.FullResult);
           end;
        if Fcb_vrfy = True then
           begin
            Fresult := '';
            Synchronize(@putresult_info);
            Fresult := '<***VRFY response***';
            Synchronize(@putresult_info);
            smtp.Verify(Fed_vrfy);
            valid_resp(smtp.FullResult);
           end;
        if Fcb_help = True then
           begin
            Fresult := '';
            Synchronize(@putresult_info);
            Fresult := '<***HELP response***';
            Synchronize(@putresult_info);
        // VER AQUI    smtp.help(Fed_help);
            valid_resp(smtp.FullResult);
           end;
        if Fcb_expn = True then
           begin
            Fresult := '';
            Synchronize(@putresult_info);
            Fresult := '***EXPN response***';
            Synchronize(@putresult_info);
     // VER AQUI       smtp.expn(Fed_expn);
            valid_resp(smtp.FullResult);
           end;
        if Fcb_size = True then
           begin
             if smtp.ESMTPSize then
                begin
                 Fresult := '';
                 Synchronize(@putresult_info);
                 Fresult := '***Size support***';
                 Synchronize(@putresult_info);
                 Fresult := inttostr(smtp.MaxSize);
                 product_size:=Fresult;
                 Synchronize(@putresult_info);
                end else
                 begin
                  Fresult := rsNotSupportSi;
                  Synchronize(@putresult_info);
                 end;
            end;
        if Fcb_auth = True then
           begin
             Fresult := '';
             Synchronize(@putresult_info);
             Fresult := '***AUTH support***';
             Synchronize(@putresult_info);
             value_temp := smtp.FindCap('AUTH');
             if Length(value_temp) >= 2 then
             value.Add(value_temp);
             valid_resp(value);
           end;
        if Fcb_tls = True then
           begin
             Fresult := '';
             Synchronize(@putresult_info);
             Fresult := '***STARTTLS support***';
             Synchronize(@putresult_info);
             value_temp := smtp.FindCap('STARTTLS');
             if Length(value_temp) >= 2 then
             value.Add(value_temp);
             valid_resp(value);
           end;
         if Fcb_swver = True then
           begin
            Fresult := '';
            Synchronize(@putresult_info);
            Fresult := '***Software version***';
            Synchronize(@putresult_info);
            table.Delimiter:='|';
            table.FirstLineAsSchema:=True;
            if FileExists(fprincipal.pathdb+'smtpver.db') then
              begin
               table.FileName:= fprincipal.pathdb+'smtpver.db';
               table.Active:=True;
               table.First;
              end else
              begin
               Fresult := 'Database smtpver.db not exist, aborted';
               Synchronize(@putresult_info);
               abort;
              end;
            telnt.Timeout := Ftimeout;
            telnt.TargetHost := Fip;
            telnt.TargetPort := Fport;
            if telnt.Login then
              begin
               banner:= telnt.RecvString;
               while not table.EOF do
                begin
                 respsmtp:= Parseversion(banner,
                 table.FieldByName('response').Value,table.FieldByName('regex').Value);
                 if respsmtp <> '' then
                  break;
                 table.Next;
                end;

                 //For response of command help
                 if respsmtp ='' then
                  begin
                   table.First;
       // VER            smtp.help('');
                   rehelp:= smtp.FullResult.Text;
                   while not table.EOF do
                     begin
                      respsmtp:= Parseversion(rehelp,
                      table.FieldByName('response').Value,table.FieldByName('regex').Value);
                      if respsmtp <> '' then
                         break;
                      table.Next;
                     end;
                  end;

                if respsmtp <> '' then
                  begin
                    if getvaluestr(respsmtp,'p/') <> '' then
                       begin
                         Fresult := 'Product: '+getvaluestr(respsmtp,'p/');
                         product_info:=getvaluestr(respsmtp,'p/');
                         Synchronize(@putresult_info);
                       end;
                    if table.FieldByName('homepage').Value <> '' then
                       begin
                         Fresult := 'Web site: '+
                         table.FieldByName('homepage').Value;
                         Synchronize(@putresult_info);
                       end;

                    if getvaluestr(respsmtp,'v/') <> '' then
                       begin
                         Fresult := 'Version: '+getvaluestr(respsmtp,'v/');
                         product_ver:=getvaluestr(respsmtp,'v/');
                         Synchronize(@putresult_info);
                       end;
                    if getvaluestr(respsmtp,'h/') <> '' then
                       begin
                         Fresult := 'Host: '+getvaluestr(respsmtp,'h/');
                         product_host:=Fresult;
                         Synchronize(@putresult_info);
                       end;
                    if getvaluestr(respsmtp,'i/') <> '' then
                       begin
                         Fresult := 'Info: '+getvaluestr(respsmtp,'i/');
                         Synchronize(@putresult_info);
                       end;
                    if getvaluestr(respsmtp,'o/') <> '' then
                       begin
                         Fresult := 'OS: '+getvaluestr(respsmtp,'o/');
                         product_os:=Fresult;
                         Synchronize(@putresult_info);
                       end;
                    if table.FieldByName('logo').Value <> '' then
                     begin
                      filelogo:=table.FieldByName('logo').Value;
                      logourl:=table.FieldByName('homepage').Value;
                      Synchronize(@showlogo);
                     end;
                    Fresult := 'Banner: '+banner;
                    Synchronize(@putresult_info);
                  end;
              end;
           end;
         end else
            Begin
             Fresult := Fhost+' '+rsTheRemoteSer;
             Synchronize(@putresult_info);
            end;
//  fprincipal.bottom_result(fprincipal.sgresult4);
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[4]);
  filedetails.SaveToFile(GetTempDir+'smtputils_info.txt');
  smtp.Free;
  telnt.Free;
  value.Free;
  filedetails.Free;
  fprincipal.enable_button(true,fprincipal.acinfo);
  fprincipal.enable_button(False,fprincipal.acinfo_stop);
end;

function Tinfo.getvaluestr(cad, sep: String): String;
var
 posi,posf, i : integer;
begin
 posi:=PosEx(sep,cad);
 for i:=posi+2 to Length(cad) do
  if Copy(cad,i,1) = '/' then
     begin
      posf:=i;
      break
     end;
  Result:= copy(cad,posi+2,posf-posi-2);
end;

function Tinfo.Parseversion(const AInputString, ATemplate, exp: string
  ): string;
var
 r : TRegExpr;
begin
 r := TRegExpr.Create;
 try
   r.Expression := exp;
   if r.Exec (AInputString)
   then Result := r.Substitute (ATemplate)
   else Result := '';
 finally r.Free;
 end;
end;

constructor Tinfo.Create(CreateSuspended, Acb_etrn, Acb_vrfy, Acb_help, Acb_expn,
   Acb_size, Acb_auth, Acb_tls,Acb_sver: Boolean; Ahost, Aport, AsystemN,
  Adomain_ext, Aip, Aed_etrn, Aed_vrfy, Aed_help, Aed_expn : String; Atimeout: integer);
begin
  Fhost := Ahost;
  Fport := Aport;
  FSystemN := AsystemN;
  Fcb_etrn := Acb_etrn;
  Fcb_vrfy := Acb_vrfy;
  Fcb_help := Acb_help;
  Fcb_expn := Acb_expn;
  Fcb_size := Acb_size;
  Fcb_auth := Acb_auth;
  Fcb_tls  := Acb_tls;
  Fcb_swver := Acb_sver;
  Fed_etrn := Aed_etrn;
  Fed_vrfy := Aed_vrfy;
  Fed_help := Aed_help;
  Fed_expn := Aed_expn;
  Fdomain_ext := Adomain_ext;
  Ftimeout := Atimeout;
  smtp := TSMTPSend.Create;
  telnt := TTelnetSend.Create;
  table := TSdfDataSet.Create(nil);
  filedetails := TStringList.Create;
  Fip := Aip;
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;


{ Tresolvemx }
{ Implementation of Resolve MX Thread }

procedure Tresolvemx.putresult_mx;
begin
 fprincipal.edhost.Items.Clear;
 fprincipal.edhost.Items.AddStrings(List);
 fprincipal.edhost.Text := Fresult1;
 fprincipal.edhost.ItemIndex := 0;
 fprincipal.edip.Text := Fresult2;
end;

procedure Tresolvemx.Execute;
var
 DNSServer : String;
begin
 Fresult1 := rsWaitForResol;
 Fresult2 := rsWaitForResol;
 Synchronize(@putresult_mx);
 DNSServer := SeparateLeft(GetDNS,',');
 GetMailServers(DNSServer,DomainN,List);
   if List.Count >= 1 then
    begin
     Fresult1 := List.ValueFromIndex[0];
     Synchronize(@putresult_mx);
     fprincipal.sbresolveipClick(nil);
    end else
     begin
     Fresult1 := rsNotResolveMX;
     Fresult2 := rsCannotResolv;
     Synchronize(@putresult_mx);
     end;
 Sock.Free;
 List.Free;
end;

constructor Tresolvemx.Create(CreateSuspended: Boolean; Adomain: String);
begin
  Sock := TBlockSocket.Create;
  List := TStringList.Create;
  DomainN := Adomain;
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

{ Tresolvip }
{ Implementation of Resolve IP Thread }

procedure Tresolvip.putresult_ip;
begin
 fprincipal.edip.Items.Clear;
 fprincipal.edip.Items.AddStrings(List);
 fprincipal.edip.ItemIndex := 0;
end;

procedure Tresolvip.Execute;
begin
  Sock.ResolveNameToIP(HostN,List);
  Synchronize(@putresult_ip);
  List.Free;
  Sock.Free;
end;

constructor Tresolvip.Create(CreateSuspended: Boolean; Ahost: String);
begin
 Sock := TBlockSocket.Create;
 List := TStringList.Create;
 HostN := Ahost;
 FreeOnTerminate := True;
 inherited Create(CreateSuspended);
end;

{ Tdnsbl }
{ Implementation of DNSBL test Thread }

procedure Tdnsbl.putresult_dnsbl;
begin
 fprincipal.sgresult5.RowCount := fprincipal.sgresult5.RowCount+1;
 fprincipal.sgresult5.Cells[0,fprincipal.sgresult5.RowCount-1] := Fresult;
end;

procedure Tdnsbl.putincpb_dnsbl;
begin
 fprincipal.pbdnsbl.Position := Fvalpb_dnsbl;
end;

procedure Tdnsbl.Execute;
var
 dbdnsbl : String;
 list_result : TStringList;
 i, hole, secur : Integer;
begin
  list_result := TStringList.Create;
  fprincipal.enable_button(false, fprincipal.acdnsbl);
  hole := 0;
  secur := 0;
  dnsclient.Timeout := Ftimeout;
  if Fsetdns then
     dnsclient.TargetHost := Fdnserver
  else
     dnsclient.TargetHost := SeparateLeft(GetDNS,',');
  fprincipal.header_result(rsDNSBLTest, fprincipal.sgresult5);
  dbdnsbl := fprincipal.pathdb+'dnsbl.dbf';
  if FileExists(dbdnsbl) then
      Begin
        table.TableName := dbdnsbl;
        table.Active := True
      end
    else
      Begin
       Fresult := rsFileNotFound + dbdnsbl;
       Synchronize(@putresult_dnsbl);
      end;
  i := 0;
  table.First;
  fprincipal.pbdnsbl.Max := table.RecordCount;
  while not table.EOF do
  Begin
   if not Terminated then
   begin
     i := i + 1;
     if table.FieldByName('APPLY').Value = True then
      Begin
        list_result.Clear;
        Fresult := table.FieldByName('DESCRIPT').Value;
        Synchronize(@putresult_dnsbl);
        Fresult := '--> '+rsSendDnsQuery+ReverseIP(Fip)+'.'+
                    table.FieldByName('SERVER').Value;
        Synchronize(@putresult_dnsbl);
        dnsclient.DNSQuery(ReverseIP(Fip)+'.'+
        table.FieldByName('SERVER').Value,Qtype_A,list_result);
        if (list_result.Count >=1) and (dnsclient.RCode = 0) then
           begin
            dnsclient.DNSQuery(ReverseIP(Fip)+'.'+
            table.FieldByName('SERVER').Value,Qtype_TXT,list_result);
            Fresult := '<-- '+rsFound+list_result.Text;
            Synchronize(@putresult_dnsbl);
            hole := hole+1;
            Fresult := '';
            Synchronize(@putresult_dnsbl);
           end else
           begin
            if dnsclient.RCode = 3 then
            begin
             secur := secur+1;
             Fresult := '<-- '+rsNotFound;
             Synchronize(@putresult_dnsbl);
             Fresult := '';
             Synchronize(@putresult_dnsbl);
            end;
            if dnsclient.RCode in [1,2,4,5] then
             begin
              Fresult := rsFailure;
              Synchronize(@putresult_dnsbl);
             end;
           end;
      end;
   end else
   begin
    Fresult := rsAbortByUser;
    Synchronize(@putresult_dnsbl);
    break
   end;
   table.Next;
   Fvalpb_dnsbl := table.RecNo;
   Synchronize(@putincpb_dnsbl);
  end; //End of table

  if secur >=1 then
     Begin
      Fresult := rsNotFound2+IntToStr(secur);
      Synchronize(@putresult_dnsbl);
     end;
   if hole >= 1 then
     Begin
      Fresult := rsFound+inttostr(hole);
      Synchronize(@putresult_dnsbl);
     end else
      begin
       Fresult := rsCongratulati2;
       Synchronize(@putresult_dnsbl);
      end;
     
  dnsclient.free;
  fprincipal.bottom_result(fprincipal.sgresult5);
  fprincipal.enable_button(true,fprincipal.acdnsbl);
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[5]);
  fprincipal.enable_button(False,fprincipal.acdnsbl_stop);
  Fvalpb_dnsbl := 0;
  Synchronize(@putincpb_dnsbl);
  table.Active := False;
  list_result.Free;
end;

constructor Tdnsbl.Create(CreateSuspended, Asetdns: Boolean; Aip, Adnserver: String;
  Atimeout: integer);
begin
  Fip := Aip;
  Ftimeout := Atimeout;
  Fdnserver := Adnserver;
  dnsclient := TDNSSend.Create;
  Fsetdns := Asetdns;
  FreeOnTerminate := True;
  table := TDbf.Create(nil);
 inherited Create(CreateSuspended);
end;

{ Tspf }

procedure Tspf.putresult_spf;
begin
 fprincipal.sgresult6.RowCount := fprincipal.sgresult6.RowCount+1;
 fprincipal.sgresult6.Cells[0,fprincipal.sgresult6.RowCount-1] := Fresult;
end;

procedure Tspf.Not_found;
Begin
 Fresult := rsNotSPFRecord;
 Synchronize(@putresult_spf);
 Fresult := '';
 Synchronize(@putresult_spf);
end;


procedure Tspf.Execute;
var
 cou         : integer;
 list_result : TStringList;
 found_spf: boolean;
 varec, vmxrec, vptrrec, va_rec : String;
 vmx_rec, vip_rec, vinclu_rec, vall, spfb : String;
begin
  found_spf := False;
  list_result := TStringList.Create;
  fprincipal.enable_button(false, fprincipal.acspf_start);
  dnsclient.Timeout := Ftimeout;
  dnsclient.TargetHost := SeparateLeft(GetDNS,',');
  fprincipal.header_result(rsSPFSupport2, fprincipal.sgresult6);
  dnsclient.DNSQuery(Fdomain,Qtype_TXT,list_result);
  //Put info for query spf
  Fresult := '--> '+rsQueryDnsForS;
  Synchronize(@putresult_spf);
  //validate TXT record from dns
  if (list_result.Count >=1) and (dnsclient.RCode = 0) then
    begin
      for cou := 0 to list_result.Count-1 do
      begin
       if Copy(list_result.Strings[cou],1,6)= 'v=spf1' then
          begin
           found_spf := True;
           Fresult := '<-- SPF record: '+list_result.Strings[cou];
           Synchronize(@putresult_spf);
           Fresult := '';
           Synchronize(@putresult_spf);
          end
      end;
      if found_spf = False then
         Not_found;
    end else
    if (list_result.Count =0) and (dnsclient.RCode = 0) then
        begin
         found_spf := False;
         Not_found; //print Not found spf record
        end else
      begin
       if dnsclient.RCode = 3 then
          Not_found;
       if dnsclient.RCode in [1,2,4,5] then
          begin
           Fresult := rsFailure;
           Synchronize(@putresult_spf);
          end;
      end;

  //buid spf record from form
  Fresult := rsPleaseTransf;
  Synchronize(@putresult_spf);
  
  if FArec = True then
     varec := ' a' else
     varec := '';
  if FMXrec = True then
     vmxrec := ' mx' else
     vmxrec :='';
  if FPTRrec = True then
     vptrrec := ' ptr' else
     vptrrec := '';
  if Length(FMA) > 0 then
     va_rec := ' a:'+FMA else
     va_rec :='';
  if Length(FMMX) > 0 then
     vmx_rec := ' mx:'+FMMX else
     vmx_rec := '';
  if Length(FMIPV4) > 0 then
     vip_rec := ' ip4:'+FMIPV4 else
     vip_rec := '';
  if Length(Fedinclude) > 0 then
     vinclu_rec := ' include:'+Fedinclude else
     vinclu_rec := '';
  if Fall = True then
     vall := ' ~all' else
     vall := ' ?all';

  spfb := 'v=spf1'+varec+vmxrec+vptrrec+va_rec+vmx_rec+vip_rec+vinclu_rec+vall;

  //print spf record
  Fresult := spfb;
  Synchronize(@putresult_spf);
  Fresult := '';
  Synchronize(@putresult_spf);


  //For bind dns server
  Fresult := rsIfYouRunBIND;
  Synchronize(@putresult_spf);
  Fresult := Fdomain+'.'+' IN TXT '+'"'+spfb+'"';
  Synchronize(@putresult_spf);
  Fresult := '';
  Synchronize(@putresult_spf);
  
  //For tinydns dns server
  Fresult := rsIfYouRunTiny;
  Synchronize(@putresult_spf);
  Fresult := ''''+Fdomain+':'+spfb+':3600';
  Synchronize(@putresult_spf);
  Fresult := ''''+'YOUR_HOSTNAME_DNS_SERVER:'+spfb+':3600';
  Synchronize(@putresult_spf);
  Fresult := '';
  Synchronize(@putresult_spf);

  //For Windows DNS server
  Fresult := rsIfYouRunWind;
  Synchronize(@putresult_spf);
  Fresult := rsPleaseSeeHtt;
  Synchronize(@putresult_spf);
  Fresult := '';
  Synchronize(@putresult_spf);
  dnsclient.free;
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[6]);
  fprincipal.bottom_result(fprincipal.sgresult6);
  fprincipal.enable_button(true,fprincipal.acspf_start);
  list_result.Free;
end;

constructor Tspf.Create(CreateSuspended, AArec, AMXrec, APTRrec,
  Aallrec: Boolean; ADomain, Ama, Ammx, Amipv4, Aedinclude: String;
  Atimeout: integer);
begin
  FArec := AArec;
  FMXrec := AMXrec;
  FPTRrec := APTRrec;
  Fall := Aallrec;
  Fdomain := ADomain;
  FMA := Ama;
  FMMX := Ammx;
  FMIPV4 := Amipv4;
  Fedinclude := Aedinclude;
  Ftimeout := Atimeout;
  dnsclient := TDNSSend.Create;
  FreeOnTerminate := True;
 inherited Create(CreateSuspended);
end;

{ TPingClient }

procedure TPingClient.putresult_ping;
begin
 fprincipal.sgresult7.RowCount := fprincipal.sgresult7.RowCount+1;
 fprincipal.sgresult7.Cells[0,fprincipal.sgresult7.RowCount-1] := Fresult;
end;

procedure TPingClient.putincpb_ping;
begin
  fprincipal.pbping.Position := Fvalpb_ping;
end;

procedure TPingClient.Execute;
var
 i : integer;
begin
  fprincipal.enable_button(false, fprincipal.acping_start);
  fprincipal.header_result(rsPingTest2, fprincipal.sgresult7);
  fprincipal.pbping.Max := Fcount;
  ping_client.PacketSize := Fbytes;
  for i := 1 to Fcount do
  Begin
   if not Terminated then
    begin
     if ping_client.Ping(Fip)= True then
      Begin
        Fresult := IntTostr(ping_client.PacketSize)+' bytes from '+
        ping_client.ReplyFrom+ ' '+' Time '+IntTostr(ping_client.pingtime)+
        ' ms '+ping_client.ReplyErrorDesc;
        Synchronize(@putresult_ping);
        Sleep(1000);
      end else
       begin
        Fresult := rsNoResponse;
        Synchronize(@putresult_ping);
       {$IFDEF LINUX} //For Linux
        Fresult := '';
        Synchronize(@putresult_ping);
        Fresult := rsYouAreRoot;
        Synchronize(@putresult_ping);
       {$ENDIF}
        break
       end;
    end  else
    begin
      Fresult := rsAbortByUser;
      Synchronize(@putresult_ping);
      break
    end;
   Fvalpb_ping := i;
   Synchronize(@putincpb_ping);
  end; //End cicle
  ping_client.free;
  fprincipal.bottom_result(fprincipal.sgresult7);
  fprincipal.enable_button(true,fprincipal.acping_start);
  fprincipal.fin_test(fprincipal.pcontrol_result.Pages[7]);
  fprincipal.enable_button(False,fprincipal.acping_stop);
  Fvalpb_ping := 0;
  Synchronize(@putincpb_ping);
end;

constructor TPingClient.Create(CreateSuspended: Boolean; Aip: String; Acount,
  Abytes: integer);
begin
  Fip:= Aip;
  Fcount:= Acount;
  Fbytes:= Abytes;
  ping_client := TPingSend.Create;
  FreeOnTerminate := True;
 inherited Create(CreateSuspended);
end;

initialization
  {$I uprinc.lrs}
end.


